We help IT Professionals succeed at work.

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

5,529 Views
Last Modified: 2014-05-22
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
Comment
Watch Question

Jeffrey CoachmanMIS Liason
CERTIFIED EXPERT
Most Valuable Expert 2012

Commented:
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

Author

Commented:
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.
MIS Liason
CERTIFIED EXPERT
Most Valuable Expert 2012
Commented:
This one is on us!
(Get your first solution completely free - no credit card required)
UNLOCK SOLUTION

Author

Commented:
Jeff,

That works perfectly.

Thank you.

Author

Commented:
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"
Jeffrey CoachmanMIS Liason
CERTIFIED EXPERT
Most Valuable Expert 2012

Commented:
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

Author

Commented:
Ok I will do that.

Sorry.
Jeffrey CoachmanMIS Liason
CERTIFIED EXPERT
Most Valuable Expert 2012

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

Gain unlimited access to on-demand training courses with an Experts Exchange subscription.

Get Access
Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Empower Your Career
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE

Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

  • Troubleshooting
  • Research
  • Professional Opinions
Unlock the solution to this question.
Join our community and discover your potential

Experts Exchange is the only place where you can interact directly with leading experts in the technology field. Become a member today and access the collective knowledge of thousands of technology experts.

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.