Access VBA dialog box to import multiple CSV and xls and query

Question

I need a VBA to import multiple CSV and xls files using a dialog box for the end user. The number of files changes every time as well as files name and location on a server (\myservername). Often the files do not have headings in the first row but in the 5th or 6th one because they have report title and info in the first rows. The files have at least on column with the same name (Item_Number) but with duplicate records in that specific column. The number of fields and names are not the same for each file but there my be multiple fields repeated in each file. At the end, I need a query in the same code to merge all the new tables and export everything in an Excel file with a dialog box to choose the location where to save it. The primary key among the tables is always the Item_Number but there may be duplicates in as said before. Thank you

Code found that doesn't work.

Function File_Dialog_Box() As String

On Error GoTo catchError
txtPath = ""
Set fso = CreateObject("Scripting.FileSystemObject")
Dim directory As String, fileName As String, total As Integer
Dim fd As Object
Set fd = Application.FileDialog(3)

With fd
.AllowMultiSelect = False
.Title = "Please select the file."
.Filters.Clear
.Filters.Add "Custom Excel Files", "*.xlsx, *.csv, *.xls"

If .Show = True Then
txtPath = Dir(.SelectedItems(1))
End If
txtPath = fso.GetFileName(.SelectedItems(1))
End With
File_dailog = txtPath
exit_catchError:
Exit Function
catchError:
If Err.Number = 5 Then
Exit Function
End If

MsgBox ("File has been uploaded. Do you want to upload another file?")

End Function

If not more files have been chosen by the end user, the VBA starts the query with the current tables.

Answer 1

You can easily import all CSV files into one single table (obviously, all files need to have the same schema).

Private Sub Command1_Click()

Dim strPathFile As String, strFile As String, strPath As String
        Dim strTable As String, strBrowseMsg As String
        Dim blnHasFieldNames As Boolean

        ' Change this next line to True if the first row in EXCEL worksheet
        ' has field names
        blnHasFieldNames = False

        strBrowseMsg = "Select the folder that contains the CSV files:"

        strPath = "C:\your_path\"

        If strPath = "" Then
              MsgBox "No folder was selected.", vbOK, "No Selection"
              Exit Sub
        End If

        ' Replace tablename with the real name of the table into which
        ' the data are to be imported
        strTable = "tablename"

        strFile = Dir(strPath & "\*.csv")
        Do While Len(strFile) > 0
              strPathFile = strPath & "\" & strFile

        DoCmd.TransferText acImportDelim, , strTable, strPathFile, blnHasFieldNames

        ' Uncomment out the next code step if you want to delete the
        ' EXCEL file after it's been imported
        '       Kill strPathFile

              strFile = Dir()
        Loop
End Sub

Or...import each CSV into a separate table, unique to each CSV file.

Private Sub Command2_Click()

 Dim strPathFile As String
 Dim strFile As String
 Dim strPath As String
 Dim strTable As String
 Dim blnHasFieldNames As Boolean

 ' Change this next line to True if the first row in CSV worksheet
 ' has field names
 blnHasFieldNames = True

 strPath = "C:\your_path\"

 ' Replace tablename with the real name of the table into which
 ' the data are to be imported

 strFile = Dir(strPath & "*.csv")


 Do While Len(strFile) > 0
       strTable = Left(strFile, Len(strFile) - 4)
       strPathFile = strPath & strFile
       DoCmd.TransferText acImportDelim, , strTable, strPathFile, blnHasFieldNames

 ' Uncomment out the next code step if you want to delete the
 ' EXCEL file after it's been imported
 '       Kill strPathFile

       strFile = Dir()
 Loop

End Sub

Answer 2

You should set multiselect on. try following code to link or import files then merge them:

Sub Importer()
    Dim fDialog As Office.FileDialog
    Dim FileName As Variant
    Dim TableName As String
    Dim TableCnt As Integer
Dim FileFlag As Integer

    '......... File Dialog ............
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    With fDialog
        .AllowMultiSelect = True
        .Title = "Select KPI csv files."
        .Filters.Add "MY FILE TYPES", "*.csv;*.xls;*.xlsx", 1
        .FilterIndex = 1
        .InitialFileName = Environ("userprofile") & "\Desktop\Q3\"
        If .Show = False Then
            Exit Sub
        End If
    End With

    '............ Import files ................
    DoCmd.SetWarnings False
    For Each FileName In fDialog.SelectedItems
        Select Case Right(FileName, 4)
            Case ".csv"
                FileFlag = CheckCSVFileType(CStr(FileName))
                If FileFlag > 0 Then
                    '... set first row of importing csv file.
                    '... You should create an importing specification then go to navigation pane, set settings
                    '... to show system objects, then find MSysIMEXSpecs hidden table.
                    '... Your defined specifications settings are there.
                    '... find specID for your csv importing specification,
                    '... and change 6666 in the bellow to that number.
                    DoCmd.RunSQL ("UPDATE " & _
                        "MSysIMEXSpecs SET MSysIMEXSpecs.StartRow =" & FileFlag & _
                        " WHERE (((MSysIMEXSpecs.SpecID)=6666)); ")
                    '... Linking or importing file
                    DoCmd.TransferText _
                        acLinkDelim, _
                        "YourSpecificationName", _
                        "Table Name in access(will be merged at the end)", _
                        FileName, _
                        True
                End If
            Case ".xls", "xlsx"
                ImportXLSFileType CStr(FileName)
        End Select
    Next FileName
    DoCmd.SetWarnings True
End Sub

'.. This Function Check text file and search 10 first row to find special string which shows your data header.
'.. then return row number of heading row. If no such row found in first 10 rows, return -1.
Function CheckFileType(FileName As String) As Integer
    Dim DataStr As String
    Dim BlankCheck As Integer
    Open FileName For Input Access Read As #1
    BlankCheck = 0
    CheckFileType = -1
    Do
        BlankCheck = BlankCheck + 1
        Line Input #1, DataStr
        If InStr(1, DataStr, "Your expected string Or part of your expected header") > 0 Then
            CheckFileType = BlankCheck
        End If
    Loop While Not EOF(1) And BlankCheck < 10 And CheckFileType = -1
    Close #1
End Function

Sub ImportXLSFileType(FileName As String)
    Dim DataSheet As Worksheet
    Dim DataBook As Workbook
    Dim LastCell As String
    Dim FR As Range
    Dim DataRange As String
    Dim DelRow As Integer

    Set DataBook = Workbooks.Open(FileName, 0, False)
    DataBook.Application.WindowState = xlMinimized
    For Each DataSheet In DataBook.Worksheets
        With DataSheet
            Set FR = .Range("1:5").Find(what:="BTSNAME", lookat:=xlWhole)
            If Not FR Is Nothing Then
                DoCmd.TransferSpreadsheet _
                    acLink, _
                    acSpreadsheetTypeExcel12Xml, _
                    "Your table name in access", _
                    FileName, _
                    True, _
                    .Name & FR.Address & ":" & .Range("A" & .cells.Rows.Count).End(xlTop).End(xlRight).Address
                DoCmd.RunSQL "INSERT INTO [Importing Files] (FilePath, SheetName, Range, FileType) SELECT """ & _
                    FileName & """,""" & .Name & """,""" & DataRange & """," & hka2Gxls & ";"
            End If
        End With
    Next
End Sub