I am trying to process an excel workbook that has multiple sheets. I import each sheet one, change table to common name to run queries, then run those queries, rename the table and then attempt to import sheet 2 to do the same thing. When I import sheet 2 and try to assign the same common table name to run the same set of queries as before, I get Item Not Found In Collection error.
Option Compare Database
Dim fd2 As FileDialog
Dim xlapp, xlapp2 As New Excel.Application
Dim xlsht, xlsht2 As Excel.Worksheet
Dim xlWrkBk, xlWrkBk2 As Excel.Workbook
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
Public fileName, fileNameParsed, fileExt, fileNameNoExt, fileFolder, tName, tName2, tName3 As String
Public counter As Integer
Public tb1, tb2, tb3 As DAO.TableDef
SUB TO SELECT FILE
Code:
Dim varFile As Variant
Dim fDialog As FileDialog
DoCmd.SetWarnings (WarningsOff)
Set db = CurrentDb()
Set wrk = DBEngine.Workspaces(0)
Set fd2 = Application.FileDialog(msoFileDialogFilePicker)
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
' .Show
.AllowMultiSelect = False
.Filters.Add "Excel File", "*.xls"
.Filters.Add "Excel File", "*.xlsx"
If .Show = True Then
For Each varFile In .SelectedItems
Const acImport = 0
Const acSpreadsheetTypeExcel12Xml = 10
fileName = .SelectedItems(1) 'gets the full file path
fileExt = Right(fileName, Len(fileName) - InStrRev(fileName, "."))
fileNameParsed = fso.GetFileName(fileName) 'gets the filename with ext
If fileExt = ".csv" Then
fileNameNoExt = Replace(fileNameParsed, ".csv", "") 'file name without ext
Else
fileNameNoExt = Replace(fileNameParsed, ".xlsx", "")
End If
GetSheets varFile
Next
End If
End With
End Sub
SUB TO IMPORT SHEETS AND CALL MAIN DRIVER LOGIC
Code:
Private Sub GetSheets(strFileName)
Dim objXL As New Excel.Application
Dim wkb As Excel.Workbook
Dim wks As Object
counter = 0
'objXL.Visible = True
Set wkb = objXL.Workbooks.Open(strFileName)
For Each wks In wkb.Worksheets
counter = counter + 1
' import sheet and assign common name to run common query set.
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, TableName:="my_table", fileName:=strFileName, HasFieldNames:=True, Range:=wks.Name & "$"
mainDriver
Next
wkb.Close
Set wkb = Nothing
objXL.Quit
Set objXL = Nothing
End Sub
'MAIN LOGIC. WORKS FOR COUNTER = 1, FAILS ON COUNTER = 2. CODE IN GREEN WORKS. CODE IN RED FAILS.
Code:
Private Sub mainDriver()
'Dim tbx2 As DAO.TableDef
Dim fldFname As DAO.Fields
Dim fldLname As DAO.Fields
If counter = 1 Then
Set tb1 = db.TableDefs("my_table")
MsgBox "Counter =" & counter
CurrentDb.Execute ("ALTER TABLE my_table ALTER COLUMN [EmployerID] VARCHAR(20);")
End If
If counter = 2 Then
Set tb2 = db.TableDefs("my_table") ***** ERROR HERE ******
CurrentDb.Execute ("ALTER TABLE my_table ALTER COLUMN [Employer_ID] VARCHAR(20);")
End If
'RENAME TABLE AND EXPORT
Code:
Private Sub exportFile()
Dim vDate As String
If Format(Date, "DD") >= "01" And Format(Date, "DD") <= "15" Then
vDate = "01"
Else
vDate = "15"
End If
db.TableDefs("my_table").Name = tName
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, tName, "M:\01-HCM\06-Production Support\20-Benefits\26-Vendor Eligibility Files\Vendor Feedback\" & Format(Date, "YYYY") & "\" & Format(Date, "YYYY") & Format(Date, "MM") & vDate & "_Ben_Eligibility_File_Feedback\" & fileFolder & "\" & tName & ""
' DoCmd.RunSQL ("DROP TABLE" & tName)
End Sub