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)
        Else
            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
    Loop
Example.docx
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
   
    'Initialize
    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)
    rstTable.MoveFirst
   
    'Loop records
    Do Until rstTable.EOF
        rstTable.Edit
        rstTable("FileName") = strFullFileName
        rstTable.Update
        rstTable.MoveNext
    Loop
   
        'Clean up
        Set fld = Nothing
        Set tdf = Nothing
        Set db = Nothing
        rstTable.Close
        Set rstTable = Nothing
End Sub


JeffCoachman
Avatar of Queennie L
Queennie L

ASKER

Jeff,

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.

Thanks.
ASKER CERTIFIED SOLUTION
Avatar of Jeffrey Coachman
Jeffrey Coachman
Flag of United States of America image

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

That works perfectly.

Thank you.
Jeff,

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 & "!"


Next

wb.Close
appExcel.Quit

   On Error GoTo 0
   Exit Sub

ImportXLSheetsAsTables_Error:

    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...
;-)

JeffCoachman
Ok I will do that.

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