2
votes

I need the VBA code to import selected spreadsheets from multiple excel files into access 2007 table. Can anyone help?

This is the code I have so far.

Option Compare Database
Option Explicit

Const strPath As String = "C:\Users\person\Documents\files.xlsx"

Dim strFile As String
Dim strFileList() As String
Dim intFile As Integer

Sub Sample() 
    strFile = Dir(strPath & "*.xls")

strFile = Dir(strPath & "*.xls")
While strFile <> ""
    'adding files to the list
    intFile = intFile + 1
    ReDim Preserve strFileList(1 To intFile)
    strFileList(intFile) = strFile
    strFile = Dir()
If intFile = 0 Then
    MsgBox "No Files Found"
    Exit Sub
End If
'going through the files and linking them to access
For intFile = 1 To UBound(strFileList)
    DoCmd.TransferSpreadsheet acLink, , _
    strFileList(intFile), strPath & strFileList(intFile), True, "A5:J17"
Next
MsgBox UBound(strFileList) & "Files were linked"
End Sub
1
What is the problem you're having with the code you posted? - Ken White

1 Answers

3
votes

I don't understand all of what's going on with that code, but my hunch is it's not doing what you expect.

You declare a constant, strPath.

Const strPath As String = "C:\Users\person\Documents\files.xlsx"

Later, you concatenate "*.xls" to that constant and feed it to the Dir() function.

Sub Sample() 
    strFile = Dir(strPath & "*.xls")

I think you should try Debug.Print at that point ...

Debug.Print strPath & "*.xls"

... because the string you're giving Dir() makes it equivalent to this statement:

strFile = Dir("C:\Users\person\Documents\files.xlsx*.xls")

I doubt that matches any of the Excel files you want to process.

See whether the following code outline is useful. I don't see a need to first populate an array, then cycle through the array to link the spreadsheets. I don't see why you should need an array at all here. Avoid it if you can because the code will be simpler and ReDim Preserve is a performance-killer.

Sub Sample2()
    Const cstrFolder As String = "C:\Users\person\Documents\"
    Dim strFile As String
    Dim i As Long

    strFile = Dir(cstrFolder & "*.xls")
    If Len(strFile) = 0 Then
        MsgBox "No Files Found"
    Else
        Do While Len(strFile) > 0
            Debug.Print cstrFolder & strFile
            ' insert your code to link to link to it here '
            i = i + 1
            strFile = Dir()
        Loop
        MsgBox i & " Files were linked"
    End If
End Sub