Avatar of Queennie L
Queennie L
 asked on

Import & Add a column with filename in each multiple excel file into multiple access tables

I got this code from internet and this is what I used to import all excel files to the table. What I want is to add column to each table with filename. Is this possible? Please find attaché file for the example. Thank you.

  Dim strFolder As String
    Dim strFile As String
    Dim strTable As String
    Dim lngPos As Long
    Dim strExtension As String
    Dim lngFileType As Long
    Dim strSQL As String

    With Application.FileDialog(4) ' msoFileDialogFolderPicker
        If .Show Then
            strFolder = .SelectedItems(1)
            MsgBox "No folder specified!", vbCritical
            Exit Sub
        End If
    End With
    If Right(strFolder, 1) <> "\" Then
        strFolder = strFolder & "\"
    End If
    strFile = Dir(strFolder & "*.xls*")
    Do While strFile <> ""
        lngPos = InStrRev(strFile, ".")
        strTable = Left(strFile, lngPos - 1)
        strExtension = Mid(strFile, lngPos + 1)
        Select Case strExtension
            Case "xls"
                lngFileType = acSpreadsheetTypeExcel9
            Case "xlsx", "xlsm"
                lngFileType = acSpreadsheetTypeExcel12Xml
            Case "xlsb"
                lngFileType = acSpreadsheetTypeExcel12
        End Select
       DoCmd.TransferSpreadsheet _
            TransferType:=acImport, _
            SpreadsheetType:=lngFileType, _
            TableName:=strTable, _
            FileName:=strFolder & strFile, _
            HasFieldNames:=True ' or False
        strFile = Dir
Microsoft AccessMicrosoft DevelopmentMicrosoft Applications

Avatar of undefined
Last Comment
Jeffrey Coachman

8/22/2022 - Mon
Jeffrey Coachman

How much do you know about VBA?

I am sure the code you are using works,
...but as far as importing a single file, adding the field and populating the field, ...
This works fine for me.
I am sure you can extract the needed DAO code to add the field and populate it, then in insert it a the appropriate location in your code.

'Declare Variables
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Dim rstTable As DAO.Recordset

Dim strTable As String
Dim strFolder As String
Dim strFile As String
Dim strFullFileName As String

'Set Variables
strTable = "YourTable2"
strFolder = "C:\YourFolder\"
strFile = "Junk.xlsx"
strFullFileName = strFolder & strFile
    'Import the Spreadsheet
    DoCmd.TransferSpreadsheet acImport, , strTable, strFullFileName, True
    Set db = CurrentDb()
    Set tdf = db.TableDefs(strTable)
    'Add the field to the table.
    tdf.Fields.Append tdf.CreateField("FileName", dbText, 255)
    'Create Recordset
    Set rstTable = db.OpenRecordset(strTable)
    'Loop records
    Do Until rstTable.EOF
        rstTable("FileName") = strFullFileName
        'Clean up
        Set fld = Nothing
        Set tdf = Nothing
        Set db = Nothing
        Set rstTable = Nothing
End Sub

Queennie L


I am just a novice. I am learning VBA.

Is this code is for single table? I have multiple excel files imported to multiple access tables.

All I want is to add filename into new column to each imported table.

Jeffrey Coachman

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
Queennie L


That works perfectly.

Thank you.
This is the best money I have ever spent. I cannot not tell you how many times these folks have saved my bacon. I learn so much from the contributors.
Queennie L


I have another question:
Sorry to bug you.

How to add filename to the table column with this code?

Dim appExcel As Excel.Application
Dim wb As Excel.Workbook
Dim sh As Excel.Worksheet
Dim strValue As String

   On Error GoTo ImportXLSheetsAsTables_Error

Set appExcel = CreateObject("Excel.Application")
Set wb = appExcel.Workbooks.Open("C:\Documents and Settings\" & Environ("UserName") & "\Desktop\Excel_Test.xlsx")
For Each sh In wb.Sheets
Debug.Print sh.Name
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "tbl_" & sh.Name, "C:\Documents and Settings\" & Environ("UserName") & "\Desktop\Excel_Test.xlsx", True, sh.Name & "!"



   On Error GoTo 0
   Exit Sub


    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure ImportXLSheetsAsTables of Module Module9"
Jeffrey Coachman

I'm confused...?

You stated that my post solved your original question.
If this is the case, then you should accept my post as the solution.

Then you can post this new code as a new question. (To avid confusion)
With any luck, you may even get a neater explanation/solution...

Queennie L

Ok I will do that.

Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
Jeffrey Coachman

Thanks,...I'll look for your follow up post...