Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here


access import with file name from excel

access import with file name from excel

access import with file name from excel

Can anyone help, i need to import multiple Excel file to an access table, all the same fields, but when they import it adds the file name to a new colmun in the table...

The files are imported weekly, around 50-60 of them

Thanks in advance....

RE: access import with file name from excel

The following (from This Eng-Tips thread) was to combine data from multiple spreadsheets into a single spreadsheet, adding the source file names to the compiled sheet.

All the parts you need should be there, just need to output to Access rather than Excel. Or use as-is and then move the resulting Excel to Access.

CODE --> VBA(excel)

Function BrowseForFolder(Optional OpenAt As Variant, Optional Prompt As String) As String
     'Function purpose:  To Browse for a user selected folder.
     'If the "OpenAt" path is provided, open the browser at that directory
     'If the "Promp" is provided it will appear below the dialog header bar.
     'NOTE:  If invalid, it will open at the Desktop level
    Dim ShellApp As Object
     'Create a file browser window at the default folder
    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, Prompt, 0, OpenAt)
     'Set the folder to that selected.  (On error in case cancelled)
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0
     'Destroy the Shell Application
    Set ShellApp = Nothing
     'Check for invalid or non-entries and send to the Invalid error
     'handler if found
     'Valid selections can begin L: (where L is a letter) or
     '\\ (as in \\servername\sharename.  All others are invalid
    Select Case Mid(BrowseForFolder, 2, 1)
    Case Is = ":"
        If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
    Case Is = "\"
        If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
    Case Else
        GoTo Invalid
    End Select
    Exit Function
     'If it was determined that the selection was invalid, set to False
    BrowseForFolder = False
End Function

Public Function GetFileNames(oPath As String, Optional fExt As String) As String()

'Function Purpose:  Returns an array of the file names in the oPath directory.
'If the optional fExt is provided only files matching the extension are returned.
'If fExt is not provided then all files are returned.

Dim FileArray() As String
Dim fname As String
Dim SlashExt As String
Dim count As Integer

If fExt <> "" Then
    If Left(fExt, 1) = "." Then fExt = Right(fExt, Len(fExt) - 1) 'Allows fExt to be specified with or without "."
    SlashExt = "\*." & fExt
    SlashExt = "\*.*" 'Set extension to all if option fExt is not provided
End If

ReDim FileArray(1 To 2)

fname = Dir(oPath & SlashExt) 'Get first file name
count = 0
Do Until fname = ""    ' Start the loop.
    count = count + 1
    ReDim Preserve FileArray(1 To count)
    FileArray(count) = fname
    fname = Dir ' Get next entry.
GetFileNames = FileArray
End Function

Public Function LastRow(MySheet As Excel.Worksheet) As Integer
LastRow = MySheet.UsedRange.Rows.count + MySheet.UsedRange.Row - 1
End Function

Sub MashFiles()

'Procedure Purpose:  Consolidate data from multiple spreadheets into a single spreadsheet.
'Works only with ActiveWorkBook.Sheets(1)
'For each of the multiple spreadsheets ActiveWorkBook.Sheets(1).Name is inserted into Column A of the consolidated sheet.

Dim aPath As String
Dim FileArray() As String
Dim i As Long
Dim r As Integer
Dim myxlapp As Object
Dim DestinationFile As String
Dim DestinationFolder As String
Dim MasterIndex As Excel.Workbook
Dim MasterSheet As Excel.Worksheet
Dim PartIndex As Excel.Workbook
Dim PartSheet As Excel.Worksheet

'Select the path containing the files to process and load .xls files into an array
aPath = BrowseForFolder(, "Select Folder with Files for Processing")
FileArray = GetFileNames(aPath, "xls")

'Set up a file to hold the composite
DestinationFile = InputBox("Name for Destination Spreadsheet")
If Right(DestinationFile, 4) <> ".xls" Then DestinationFile = DestinationFile & ".xls"
DestinationFolder = BrowseForFolder(, "Select a folder for the Destination Spreadsheet")

'open an Excel spreadsheet
Set myxlapp = CreateObject("Excel.Application")
Set MasterIndex = myxlapp.Workbooks.Add
Set MasterSheet = MasterIndex.Worksheets(1)
myxlapp.Visible = True

'Run though each file and do stuff
Application.ScreenUpdating = False
For i = 1 To UBound(FileArray)
    fullfilename = aPath & "\" & FileArray(i)
    Set PartIndex = myxlapp.Workbooks.Open(fullfilename)
    Set PartSheet = PartIndex.Sheets(1)
    PartSheet.Columns("A:A").Insert shift:=xlToRight
        For r = 1 To LastRow(PartSheet)
            PartSheet.Cells(r, 1).Value = PartSheet.Name
        Next r
    MasterSheet.Range("A1").Cells(LastRow(MasterSheet) + 1, 1).PasteSpecial
Next i
MasterIndex.SaveAs (DestinationFolder & "\" & DestinationFile)
Application.ScreenUpdating = True
End Sub 

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members!


Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close