Hi, I'm lookingo for the way how to iport multiple xls files fro a few subfolders. I have a lot of files with the same names in a different subdir's. For example: Dir name - OFFICE , Subdir's - AA (with 2012.xls, 2013 xls...), AB (with 2012.xls, 2013 xls...), BA (with 2012.xls, 2013 xls ...).
All xls files are with the same structure (the same header but with different value of records)
This code import all files to the table TEMPORARY only from one subdir. I can add next subdir manually but I need to check "Import all files from head dir Y:\OFFICE\ .For red text color i see " No file in dir". Is it possible to modify this code (MS OFFICE 2010) ?. Thanks for interesting.
Code:
Private Sub Polecenie13_Click()
'Directory Path
Dim strPath As String
Dim plik As String
Dim katalog() As String
Dim i As Integer
If Me.Lista0 = "ALL" Then
strPath = "Y:\OFFICE\"
End If
If Me.Lista0 = "AA" Then
strPath = "Y:\OFFICE\AA\"
End If
If Me.Lista0 = "AB" Then
strPath = "Y:\OFFICE\AB\"
End If
'Filename
Dim strFile As String
'File Array
Dim strFileList() As String
'File Number
Dim intFile As Integer
DoCmd.SetWarnings False
strFile = Dir(strPath & "*.xls")
Do Until strFile = ""
intFile = intFile + 1
ReDim Preserve strFileList(1 To intFile)
strFileList(intFile) = strFile
strFile = Dir()
Loop
If intFile = 0 Then
MsgBox "No file in dir"
Exit Sub
End If
For intFile = 1 To UBound(strFileList)
DoCmd.TransferSpreadsheet acImport, , _
"TEMPORARY", strPath & strFileList(intFile), True, "!A1:BG339"
DoCmd.RunSQL "UPDATE TEMPORARY SET [INITIAL] = '" & Me.Lista0.Value & "' WHERE [INITIAL] is null ;"
Next
DoCmd.SetWarnings True
MsgBox UBound(strFileList) & " files imported"
End Sub