Saving Excel Workbook Name when Importing (1 Viewer)

[moscgama]

Hi,

I'm importing multiple Excel workbooks and need to save the workbook name somewhere in the Excel spreadsheet before importing or saving the workbook name in the Access table after importing. I'm using one of Ken's import codes:

Option Compare Database
Public Function Impt_Sero()
Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean
 Dim intWorkbookCounter As Integer
 Dim lngCount As Long
 Dim objExcel As Object, objWorkbook As Object
 Dim colWorksheets As Collection
 Dim strPath As String, StrFile As String
 Dim strpassword As String
' Establish an EXCEL application object
 On Error Resume Next
 Set objExcel = GetObject(, "Excel.Application")
 If Err.Number <> 0 Then
       Set objExcel = CreateObject("Excel.Application")
       blnEXCEL = True
 End If
 Err.Clear
 On Error GoTo 0
' Change this next line to True if the first row in EXCEL worksheet
 ' has field names
 blnHasFieldNames = True
' Replace C:\MyFolder\ with the actual path to the folder that holds the EXCEL files
 strPath = "C:\Users\"
' Replace passwordtext with the real password;
 ' if there is no password, replace it with vbNullString constant
 ' (e.g., strPassword = vbNullString)
 
 strpassword = vbNullString
 blnReadOnly = True ' open EXCEL file in read-only mode
 StrFile = Dir(strPath & "*.xls")
 intWorkbookCounter = 0
 
 Do While StrFile <> ""
       intWorkbookCounter = intWorkbookCounter + 1
       Set colWorksheets = New Collection
       Set objWorkbook = objExcel.Workbooks.Open(strPath & StrFile, , _
             blnReadOnly, , strpassword)
      For lngCount = 1 To objWorkbook.Worksheets.Count
             colWorksheets.Add objWorkbook.Worksheets(lngCount).Name
       Next lngCount
       
       ' Close the EXCEL file without saving the file, and clean up the EXCEL objects
       objWorkbook.Close False
       Set objWorkbook = Nothing
       ' Import the data from each worksheet into a separate table
       For lngCount = colWorksheets.Count To 1 Step -1
             DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
                   "tbl" & colWorksheets(lngCount) & intWorkbookCounter, _
                   strPath & StrFile, blnHasFieldNames, _
                   colWorksheets(lngCount) & "$" & "A23:N142"
       Next lngCount
       ' Delete the collection
       Set colWorksheets = Nothing
 
 'Uncomment out the next doe step if you want to delete the
 'Excel file after its been imported
 'Kill strPath & strFile
 
 StrFile = Dir()
 
 Loop
 
 If blnEXCEL = True Then objExcel.Quit
 Set objExcel = Nothing
 
End Function

Does anyone have a resource they could suggest for me to use? I haven't been able to find anything that suites my needs (basically, I'm a terrible googler!). Thanks in advance!

Best,

Moscgama