msoFileDialogFilePicker read multiple files into seperate tables

[gammaman]

I am trying to use msoFileDialogFilePicker to select 2 excel files. I want to open each file and read the first row of the file into its own access table. It works fine for one file but when I have 2 files it only reads data from the one file.

DoCmd.RunSQL ("CREATE TABLE [GPS_NOT_CLIENT]")   'Create the loading table
DoCmd.RunSQL ("CREATE TABLE [CLIENT_NOT_GPS]")   'Create the loading table
Set tb1 = db.TableDefs("GPS_NOT_CLIENT")         'Create a table definition to add fields to loading table
Set tb2 = db.TableDefs("CLIENT_NOT_GPS")         'Create a table definition to add fields to loading table
Set fd2 = Application.FileDialog(msoFileDialogFilePicker)
tNameCount = 0
tSheetCount = 1

With fd2
.AllowMultiSelect = True
.Show
For Each vrtSelected In .SelectedItems

    Set xlapp = CreateObject("Excel.application")
   Set xlWrkBk = GetObject(vrtSelected)
   Set xlsht = xlWrkBk.Worksheets(tSheetCount)
   
'Application.CutCopyMode = False
   
   
   'Loop First Row in Excel File which contains header column names

   strcolumns = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "AA", "AB", "AC", "AD", "AE", "AF", "AG", "AH", "AI", "AJ", "AK", "AL", "AM", "AN", "AO", "AP", "AQ", "AR", "AS", "AT", "AU", "AV", "AW", "AX", "AY", "AZ", "BA", "BB", "BC", "BD", "BE", "BF", "BG", "BH", "BI", "BJ", "BK", "BL", "BM", "BN", "BO", "BP", "BQ", "BR", "BS", "BT", "BU", "BV", "BW", "BX", "BY", "BZ", "CA", "CB", "CC", "CD")


   For Each strColumn In strcolumns

      counter = counter + 1                         'increase the counter to determine the number of columns
      Set columnName = xlsht.Cells(1, strColumn)

      If tSheetCount = 1 Then

      If columnName = "Member Birthdate" Or columnName = "Member Effdt" Then
            Set FieldName = tb1.CreateField(columnName, dbDate, 10)      'insert Date Type Fields into the table def
            tb1.Fields.Append FieldName
      Else
           Set FieldName = tb1.CreateField(columnName, dbText, 200)     'insert text type fields into table def
            tb1.Fields.Append FieldName
      End If
      End If
      
      If tSheetCount = 2 Then
      
      If columnName = "Member Birthdate" Or columnName = "Member Effdt" Then
            Set FieldName = tb2.CreateField(columnName, dbDate, 10)      'insert Date Type Fields into the table def
            tb2.Fields.Append FieldName
      Else
           Set FieldName = tb2.CreateField(columnName, dbText, 200)     'insert text type fields into table def
            tb2.Fields.Append FieldName
      End If
      End If
         
   Next strColumn


If tNameCount = 0 Then
     tName = "GPS_NOT_CLIENT"
   End If
   If tNameCount = 1 Then
     tName = "CLIENT_NOT_GPS"
   End If
   
  MsgBox (tNameCount)
  MsgBox (tName)
   
  ' MsgBox ("Choose Cenus File")
   'transfers data from excel file and imports it into access table
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, TableName:=tName, FileName:=vrtSelected, HasFieldNames:=True

   Next i
    tNameCount = tNameCount + 1
    tSheetCount = tSheetCount + 1
Next vrtSelected
End With

[Dal Jeanis]

1) Run this code and verify that multipick actually give you back multiple file names. Add any Dim statements that are needed:

Sub TestPicker()
   DoCmd.RunSQL ("CREATE TABLE [GPS_NOT_CLIENT]")  
   DoCmd.RunSQL ("CREATE TABLE [CLIENT_NOT_GPS]")  
   Set tb1 = db.TableDefs("GPS_NOT_CLIENT")        
   Set tb2 = db.TableDefs("CLIENT_NOT_GPS")        
   Set fd2 = Application.FileDialog(msoFileDialogFilePicker)
   tNameCount = 0
   tSheetCount = 1
   With fd2
      .AllowMultiSelect = True
      .Show
      For Each vrtSelected In .SelectedItems
         Debug.print vrtSelected
      Next vrtSelected
   End With
End Sub

2) you are not using xlapp at all in that code, but you are assigning it and creating a new excel app for each file picked. Either delete the unused variable or move its Dim outside the loop and use it. Also, please get in the habit of explicitly setting reference variables like that to nothing before exiting the subroutine.

Thou shalt destroy what thou createst.