Excel:宏将工作表导出为CSV文件而不离开当前的Excel工作表

Question

这里有很多问题要创建一个宏来将工作表保存为CSV文件.所有答案都使用SaveAs,就像SuperUser中的这个.他们基本上说要创建这样的VBA函数:

Sub SaveAsCSV()
    ActiveWorkbook.SaveAs FileFormat:=clCSV, CreateBackup:=False
End Sub

这是一个很好的答案,但我想要导出而不是另存为.当SaveAs被执行时,它会引起我两个烦恼:

• 我当前的工作文件变为CSV文件.我想继续使用我原来的.xlsm文件,但要将当前工作表的内容导出到具有相同名称的CSV文件.
• 出现一个对话框,要求我确认我要重写CSV文件.

是否可以将当前工作表导出为文件,但继续在原始文件中工作？

Answer 1

@NathanClement有点快.然而,这是完整的代码(稍微复杂一点):

Option Explicit

Public Sub ExportWorksheetAndSaveAsCSV()

Dim wbkExport As Workbook
Dim shtToExport As Worksheet

Set shtToExport = ThisWorkbook.Worksheets("Sheet1")     'Sheet to export as CSV
Set wbkExport = Application.Workbooks.Add
shtToExport.Copy Before:=wbkExport.Worksheets(wbkExport.Worksheets.Count)
Application.DisplayAlerts = False                       'Possibly overwrite without asking
wbkExport.SaveAs Filename:="C:\tmp\test.csv", FileFormat:=xlCSV
Application.DisplayAlerts = True
wbkExport.Close SaveChanges:=False

End Sub

Answer 2

几乎我想要@Ralph.您的代码有一些问题:

1. 它只导出名为"Sheet1"的硬编码表;
2. 它总是导出到相同的临时文件,覆盖它;
3. 它忽略了locale分离字符.

为了解决这些问题,并满足我的所有要求,我已经从这里调整了代码.我已经清理了一点,使其更具可读性.

Option Explicit
Sub ExportAsCSV()

    Dim MyFileName As String
    Dim CurrentWB As Workbook, TempWB As Workbook

    Set CurrentWB = ActiveWorkbook
    ActiveWorkbook.ActiveSheet.UsedRange.Copy

    Set TempWB = Application.Workbooks.Add(1)
    With TempWB.Sheets(1).Range("A1")
      .PasteSpecial xlPasteValues
      .PasteSpecial xlPasteFormats
    End With        

    Dim Change below to "- 4"  to become compatible with .xls files
    MyFileName = CurrentWB.Path & "\" & Left(CurrentWB.Name, Len(CurrentWB.Name) - 5) & ".csv"

    Application.DisplayAlerts = False
    TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
    TempWB.Close SaveChanges:=False
    Application.DisplayAlerts = True
End Sub

上面的代码还有一些小问题你应该注意到:

1. .Close并且DisplayAlerts=True应该在finally子句中,但我不知道如何在VBA中执行此操作
2. 它只是当前文件名有4个字母,如.xlsm.无法在.xls excel文件中使用.对于3个字符的文件扩展名,则必须更改- 5到- 4设置MyFileName的时候.
3. 作为附属效果,您的剪贴板将替换为当前的工作表内容.

编辑:Local:=True使用我的语言环境CSV分隔符保存.

Answer 3

根据我对@neves 帖子的评论，我通过添加 xlPasteFormats 和 values 部分稍微改进了这一点，以便日期作为日期 - 我主要将银行对帐单保存为 CSV，因此需要日期。

Sub ExportAsCSV()

    Dim MyFileName As String
    Dim CurrentWB As Workbook, TempWB As Workbook

    Set CurrentWB = ActiveWorkbook
    ActiveWorkbook.ActiveSheet.UsedRange.Copy

    Set TempWB = Application.Workbooks.Add(1)
    With TempWB.Sheets(1).Range("A1")
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormats
    End With

    'Dim Change below to "- 4"  to become compatible with .xls files
    MyFileName = CurrentWB.Path & "\" & Left(CurrentWB.Name, Len(CurrentWB.Name) - 5) & ".csv"

    Application.DisplayAlerts = False
    TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
    TempWB.Close SaveChanges:=False
    Application.DisplayAlerts = True
End Sub