从 CSV 转换为 XLSX 并使用相同的文件名保存

Convert from CSV to XLSX and save with same file name

我收到了一系列 CSV 文件,这些文件捆绑在一个简单地以月份命名的文件夹中。我有代码可以找到它们、打开它们、解析它们,但我无法按照我想要的方式保存它们。我的目标是保存为与新的解析格式相同的文件名。

Sub OpenCSVs_2()
Dim MyFiles As String, ThisMonth As String, Convert As String
Dim startPath As String
ThisMonth = Format(Date, "mmmm")
startPath = "C:\Users\ME\Desktop\CSV find convert tests\" & ThisMonth & "\"
MyFiles = Dir(startPath & "*.csv")
Convert = Dir(startPath & "*xlsx")

Do While MyFiles <> ""

Workbooks.Open startPath & MyFiles

Call Parse1

ActiveWorkbook.SaveAs Filename:="startPath & Convert",      FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

MyFiles = Dir '<----------------error happens here

Loop

End Sub

上面实际上做了一些事情并创建了一个 xlsm 文件名 "startPath & Convert"。我确定解决方案就在我面前。

与我之前的 post 一样,您将变量放在引号中,然后将其转换为字符串。所以首先,删除 startPath 和 MyFiles 上的引号,然后使用 Replace 函数替换扩展名。我还添加了 Workbook 对象,因为您应该避免使用 Activeworkbook,因为它会导致问题。

Sub OpenCSVs_2()
Dim MyFiles As String, ThisMonth As String
Dim startPath As String
Dim wb As Workbook
ThisMonth = Format(Date, "mmmm")
startPath = "C:\Users\ME\Desktop\CSV find convert tests\" & ThisMonth & "\"
MyFiles = Dir(startPath & "*.csv")

Do While MyFiles <> ""

    Set wb = Workbooks.Open(startPath & MyFiles)

    Call Parse1

    wb.SaveAs Filename:=startPath & Replace(MyFiles, ".csv", ".xlsx"), FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

    MyFiles = Dir

Loop

End Sub