Reputation: 1
I am working to create a VBA/macro that imports 2 CSV files from a specific folder into 2 worksheets in an Excel template that I have created.
To be more specific, these files are created and saved as new workbooks on a daily basis (two new files being added into the folder everyday) so my problem is how to code my macro to always import the 2 latest files?
Please see below the code from which I manually select and import the latest files using macro. However, re-running the macro does not work as it shows "run-time error '5' - invalid procedure call or argument". Your help would be much appreciated.
Sub Macro1()
'
' Macro1 Macro
' IMPORT CSV FILES
'
'
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;P:\APS\Reports_From_PDP\AP_PDP_VehicleLoad_Report_AM 19-01-2018 3-15-03 AM.csv" _
, Destination:=Range("$A$1"))
.CommandType = 0
.Name = "AP_PDP_VehicleLoad_Report_AM 19-01-2018 3-15-03 AM"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Sheets.Add After:=ActiveSheet
Application.CutCopyMode = False
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;P:\APS\Reports_From_PDP\AP_PDP_VehicleLoad_Report_PM 19-01-2018 7-15-02 PM.csv" _
, Destination:=Range("$A$1"))
.CommandType = 0
.Name = "AP_PDP_VehicleLoad_Report_PM 19-01-2018 7-15-02 PM"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Sheets("Sheet1").Select
Columns("A:N").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A1").Select
Sheets("Sheet2").Select
Columns("A:N").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A1").Select
Sheets("Sheet2").Select
Sheets("Sheet2").Name = "PM"
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "AM"
Sheets("AM").Select
End Sub
Upvotes: 0
Views: 1576
Reputation: 1615
You can find the latest file(s) this way:
EDIT: Dir return only the filename, so you need to append the path, too.
EDIT2: As per user request a few Debug.Print is inserted.
Sub main()
Dim s1 as String, s2 as String
s1 = LastFile("P:\APS\Reports_From_PDP\AP_PDP_VehicleLoad_Report_AM")
Debug.Print "Last file1: " & s1
s2 = LastFile("P:\APS\Reports_From_PDP\AP_PDP_VehicleLoad_Report_PM")
Debug.Print "Last file2: " & s2
End Sub
Function LastFile(sName as String) as String
Dim dLatest as Date
Dim dFound as Date ' date of one matching filename
Dim sLatest as string ' the latest file or ""
Dim sFound as string ' one matching filename
Dim sPath as string
dLatest = 0
sLatest = vbnullstring
sPath = Left$(sName, InStrRev(sName, "\"))
sFound = Dir(sName & "*.csv")
Do While sFound <> vbnullstring
Debug.Print "Found: " & sFound
dFound = FileDateTime(sPath & sFound)
If dFound > dLatest Then
dLatest = dFound
sLatest = sFound
Endif
sFound = Dir
Loop
LastFile = sLatest
End Function
Upvotes: 1