使用VBA将多个CSV文件导入Excel中的多个工作表

使用VBA将多个CSV文件导入Excel中的多个工作表,vba,excel,csv-import,Vba,Excel,Csv Import,我正在创建一个VBA/宏,该宏将2个CSV文件从特定文件夹导入到我创建的Excel模板中的2个工作表中 更具体地说,这些文件每天创建并保存为新工作簿(每天将两个新文件添加到文件夹中),因此我的问题是如何编写宏以始终导入最新的两个文件 请参阅下面的代码,我从中使用宏手动选择和导入最新的文件。但是,重新运行宏不起作用,因为它显示“运行时错误“5”-无效的过程调用或参数”。非常感谢你的帮助 Sub Macro1() ' ' Macro1 Macro ' IMPORT CSV FILES ' '

我正在创建一个VBA/宏,该宏将2个CSV文件从特定文件夹导入到我创建的Excel模板中的2个工作表中

更具体地说,这些文件每天创建并保存为新工作簿(每天将两个新文件添加到文件夹中),因此我的问题是如何编写宏以始终导入最新的两个文件

请参阅下面的代码,我从中使用宏手动选择和导入最新的文件。但是,重新运行宏不起作用,因为它显示“运行时错误“5”-无效的过程调用或参数”。非常感谢你的帮助

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

您可以通过以下方式找到最新的文件:

EDIT:Dir只返回文件名,因此还需要附加路径

EDIT2:根据用户请求进行一些调试。插入打印

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
Sub-main()
尺寸s1为字符串,s2为字符串
s1=最后一个文件(“P:\APS\Reports\u From\u PDP\AP\u PDP\u VehicleLoad\u Report\u AM”)
调试。打印“最后一个文件1:”&s1
s2=最后一个文件(“P:\APS\Reports\u From\u PDP\AP\u PDP\u VehicleLoad\u Report\u PM”)
调试。打印“最后一个文件2:”&s2
端接头
函数LastFile(sName作为字符串)作为字符串
最迟日期
Dim dFound作为一个匹配文件名的日期
Dim sLatest作为字符串“最新文件或”
Dim S查找为字符串“一个匹配的文件名”
像细绳一样暗淡
dLatest=0
sLatest=vbnullstring
sPath=左$(sName,InStrRev(sName,“\”))
sFound=Dir(sName&“*.csv”)
在查找vbnullstring时执行此操作
Debug.Print“Found:”&s查找
dFound=FileDateTime(sPath&sFound)
如果dFound>dLatest,则
dLatest=dFound
sLatest=sFound
恩迪夫
sFound=Dir
环
LastFile=sLatest
端函数

请通过编辑原始问题将代码移到问题正文中。你好,艾伦,我已将代码添加回原始查询中。对不起,好多了。我没有答案给你,我只是把你的帖子作为一个新的海报来评论。请看Hi AcsErno,非常感谢你花时间解决我的问题。我试着在宏中插入这段代码,并删除了格式化部分,只是想看看它是否能首先提取最新的文件。但是,由于出现“运行时错误'53:找不到文件”的错误,所以它并没有很好地工作。当我点击“调试”按钮时,模块突出显示了以下代码“dFound=FileDateTime(sFound)。请提供帮助。是的,请参阅我的编辑。hi AcsErno,非常感谢您的帮助。但是,这一次,在我创建了一个新模块并点击F5后,什么也没有发生(希望这段新代码完美地导入数据…:(不确定实际问题是什么…当您
Debug.Print s1
时会发生什么?空表示在指定的路径上找不到任何文件。嗨,AcsErno,我很抱歉回复太晚。老实说,我是VBA/宏字段的新手,所以不确定如何在上述编码中输入“Debug.Print s1”。。。