Link to home
Start Free TrialLog in
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
Avatar of Jeffrey Coachman
Jeffrey Coachman
Flag of United States of America image

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

Avatar of Queennie L
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.

Avatar of Jeffrey Coachman
Jeffrey Coachman
Flag of United States of America image

Link to home
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial

That works perfectly.

Thank you.

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"
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...

Ok I will do that.

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