Import with filedialog and export with filedialog in same sub

[craig1988]

Hi all

I am having issues with this piece of code. What I need it to do is onClick:



Open the file dialog (msoFileDialogFilePicker) and import an excel file to a table.
complete a number of queries.
Open the file dialog (msoFileDialogSaveAs) and let the user export a txt file to a location of their choosing.

I have copied code from multiple sources so the code has become convoluted. I am sure there is a cleaner way of writing this. Can any one help.

Private Sub btnImport_Click()
    Dim sMyPathIn As FileDialog
    Dim sPathIn As Variant
    
    Set sMyPathIn = Application.FileDialog(msoFileDialogFilePicker)
        
    With sMyPathIn
      .AllowMultiSelect = False
      .Title = "Select your File"
      .Filters.Add "All Files", "*.*"
        If .Show = -1 Then
            For Each sPathIn In .SelectedItems
            On Error GoTo ErrHandler
                'Do stuff (run queries)
            Next sPathIn        
        Else
            sPathIn = "No File Selected to Import."
            MsgBox sPathIn
        End If
    End With
    
    Dim sMyPathOut As FileDialog
    Set sMyPathOut = Application.FileDialog(msoFileDialogSaveAs)
    With sMyPathOut
        .InitialFileName = "testFile_" & Format(Date, "yyyy.mm.dd") & ".txt"
        .Show
    End With
    
    
    Exit Sub
ErrHandler:
    MsgBox "The process was not complete. Contact Admin.", vbCritical, "Error"
    Exit Sub
End Sub

[ranman256]

'user picks a file
'usage:
txtBox = UserPick1File("c:\folder\")
docmd.transferSpreadsheet acImport, txtBox , ...etc
'save to text
docmd.transfertext  acExport , ...etc
end sub
 

Public Function UserPick1File(Optional pvPath)
Dim strTable As String
Dim strFilePath As String
Dim sDialog As String, sDecr  As String, sExt As String

'===================
'YOU MUST ADD REFERENCE : Microsoft Office xx.0 Object Library, in vbe menu, TOOLS, REFERENCES
'===================
With Application.FileDialog(msoFileDialogFilePicker)   
    .AllowMultiSelect = False
    .Title = "Locate a file to Import"
    .ButtonName = "Import"
    .Filters.Clear
    .Filters.Add "Excel Files", "*.xls;*.xlsx"
    .Filters.Add "All Files", "*.*"
    .InitialFileName = "c:\"
    .InitialView = msoFileDialogViewList    'msoFileDialogViewThumbnail
    
        If .Show = 0 Then
           'There is a problem
           Exit Function
        End If
    
    'Save the first file selected
    UserPick1File = Trim(.SelectedItems(1))
End With
End Function