Excel Forum

Code: Select all

Sub AKEKORN()
     
    Const strPath As String = "J:\ExpenseMonthly\ACCESS\excel01\" 'Directory Path
    Dim strFile As String 'Filename
    Dim strFileList() As String 'File Array
    Dim intFile As Integer 'File Number
     
  
    strFile = Dir(strPath & "*.xls")
    While strFile <> ""
         'add files to the list
        intFile = intFile + 1
        ReDim Preserve strFileList(1 To intFile)
        strFileList(intFile) = strFile
        strFile = Dir()
    Wend
     
    If intFile = 0 Then
        MsgBox "No files found"
        Exit Sub
    End If
    For intFile = 1 To UBound(strFileList)
        DoCmd.TransferSpreadsheet acImport, , _
        "RBG1", strPath & strFileList(intFile), True, "A1:d65000"
    Next
    'MsgBox UBound(strFileList) & " Files were Imported"
End Sub