☰

将工作表以 CSV 格式导出到工作簿路径

tag-icon • tag-icon microsoft-excel microsoft-excel-2010
将工作表以 CSV 格式导出到工作簿路径

我创建了一个.xlam插件，可以将任何 Excel 文件导出Worksheet为单独的CSV文件，并将它们保存为path与Workbook.

但是，当我尝试将文件保存到与打开时Workbook使用ActiveWorkbook而不是ThisWorkbook打开的同一目标时，我遇到了一个错误：

xcsvFile = ThisWorkbook.Path & "\" & xWs.Name & ".csv"

ThisWorkbook运行时没有错误，但将文件保存在加载项文件夹（C:\Users\User\AppData\Roaming\Microsoft\AddIns）中，而不是打开原始工作簿的路径中。

Sub ExportSheetsToCSV()
Dim xWs As Worksheet
Dim xcsvFile As String
For Each xWs In Application.ActiveWorkbook.Worksheets
    'Delete the first and last rows to delimit properly'
    xWs.Cells(Rows.Count, "B").End(xlUp).EntireRow.Delete
    xWs.Range("1:1").Delete
    xWs.Copy
    'Find the path of where you opened the file and save the CSV's there'
    xcsvFile = ThisWorkbook.Path & "\" & xWs.Name & ".csv"
    Application.ActiveWorkbook.SaveAs Filename:=xcsvFile, _
                                      FileFormat:=xlCSV, CreateBackup:=False
    Application.ActiveWorkbook.Saved = True
    Application.ActiveWorkbook.Close
Next
'Closes the original workbook without saving the changes'
ActiveWorkbook.Saved = True
Application.Quit

子目录结束

答案1

根据 music2myear 的评论，我能够通过首先找到工作簿路径并将其用作变量来解决问题。

    Sub ExportSheetsToCSV()
    Dim xWs As Worksheet
    Dim xcsvFile As String
    Dim folderPath As String
    folderPath = Application.ActiveWorkbook.Path
    For Each xWs In Application.ActiveWorkbook.Worksheets
        'Delete the first and last rows to delimit properly'
        xWs.Cells(Rows.Count, "B").End(xlUp).EntireRow.Delete
        xWs.Range("1:1").Delete
        xWs.Copy
        'Find the path of where you opened the file and save the CSV's there'
        xcsvFile = folderPath & "\" & xWs.Name & ".csv"
        Application.ActiveWorkbook.SaveAs Filename:=xcsvFile, _
                                          FileFormat:=xlCSV, CreateBackup:=False
        Application.ActiveWorkbook.Saved = True
        Application.ActiveWorkbook.Close
    Next
    'Closes the original workbook without saving the changes'
    ActiveWorkbook.Saved = True
    Application.Quit

End Sub

相关内容