vba 您可以使用 Excel 宏将副本自动保存为 CSV 吗

Can you have a Excel Macro to auto-save a copy as CSV

提问by Mr. Boy

Loading an XLS file is a bit of a pain for a quick app we're throwing together (we know about how to do that but it's not worth the time especially in C++) so we're going to take the simple approach of have the user export a CSV copy. However to save them the trouble I wondered if we can have a macro which will automatically save a CSV version whenever they save the XLS(X) in Excel 2007?

加载 XLS 文件对于我们正在拼凑的快速应用程序来说有点痛苦（我们知道如何做到这一点，但不值得花时间，尤其是在 C++ 中）所以我们将采用简单的方法用户导出 CSV 副本。然而，为了省去他们的麻烦，我想知道我们是否可以有一个宏，每当他们在 Excel 2007 中保存 XLS(X) 时，它会自动保存一个 CSV 版本？

Update:Following Timores' answer, I dug in a bit and came up with this:

更新：按照 Timores 的回答，我深挖了一下，想出了这个：

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFileName As String

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set Sourcewb = ActiveWorkbook
    TempFileName = Sourcewb.FullName + ".csv"

    'Copy the sheet to a new workbook
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook

    'Save the new workbook and close it
    With Destwb
        .SaveAs Filename:=TempFileName, FileFormat:=xlCSV, ConflictResolution:=xlLocalSessionChanges
        .Close SaveChanges:=False
    End With

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

This works except I can't make it force-save the CSV, rather than asking me if I want to overwrite, even after adding ConflictResolution:=xlLocalSessionChanges

这有效，除了我不能强制保存 CSV，而不是问我是否要覆盖，即使在添加之后 ConflictResolution:=xlLocalSessionChanges

采纳答案by Timores

Original version:

原始版本：

In the VB editor part of Excel, select "ThisWorkbok" in the left navigation menu. In the editor on the right, select Workbook on the left drop-down, and BeforeSave on the right one.

在 Excel 的 VB 编辑器部分，在左侧导航菜单中选择“ThisWorkbok”。在右侧的编辑器中，选择左侧下拉菜单中的 Workbook，然后选择右侧的 BeforeSave。

Replace the macro by:

将宏替换为：

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    ActiveWorkbook.SaveCopyAs ActiveWorkbook.FullName + ".csv"
End Sub

This will make a copy with the CSV extension.

这将制作一个带有 CSV 扩展名的副本。

Please note that an XLSX file cannot have a macro (you need an XLSM extension, or the older XLS one) and that users will need to have a medium or low level of security in order for the macro to run (or you have to sign the document).

请注意，XLSX 文件不能有宏（您需要 XLSM 扩展名，或旧的 XLS 扩展名），并且用户需要具有中等或低级别的安全性才能运行宏（或者您必须签署文件）。

Edited version:

编辑版本：

I tested it again, after seeing the comments below. Strangely enough, it did not work like it did the first time. Here is a fixed version. Again, in the 'This Workbook' part of the macro editor:

在看到下面的评论后，我再次测试了它。奇怪的是，它并没有像第一次那样工作。这是一个固定版本。同样，在宏编辑器的“本工作簿”部分：

Dim fInSaving As Boolean

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

If fInSaving Then
    Exit Sub
End If

fInSaving = True

Dim workbookName As String
Dim parentPath As String
Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject")

If SaveAsUI Then

    Dim result
    result = Application.GetSaveAsFilename

    If VarType(result) = vbBoolean Then
        If CBool(result) = False Then
            Exit Sub ' user cancelled the dialog box
        End If
    End If

    workbookName = fs.GetFileName(result)
    parentPath = fs.GetParentFolderName(result)
Else

    workbookName = ActiveWorkbook.name
    parentPath = ActiveWorkbook.path
End If


Dim index As Integer
index = InStr(workbookName, ".")

Dim name As String
name = Left(workbookName, index - 1)

' extension can be empty is user enters simply a name in the 'File / Save as' dialog
' so it is not computed (but hard-coded below)

' do not ask for confirmation to overwrite an existing file
Application.DisplayAlerts = False

' save a copy
ActiveWorkbook.SaveAs fs.BuildPath(parentPath, name & ".csv"), XlFileFormat.xlCSV

' Save the normal workbook in the original name
ActiveWorkbook.SaveAs fs.BuildPath(parentPath, name & ".xlsm"), XlFileFormat.xlOpenXMLWorkbookMacroEnabled
Cancel = True

Application.DisplayAlerts = True
fInSaving = False
End Sub

Private Sub Workbook_Open()

    fInSaving = False
End Sub

What is surprising is that calling ActiveWorkbook.SaveAs triggers the macro again => the global boolean to prevent infinite recursion.

令人惊讶的是，调用 ActiveWorkbook.SaveAs 再次触发宏 => 全局布尔值以防止无限递归。

回答by Charles Williams

to avoid XL asking if you want to overwrite use Application.DisplayAlerts=False (and then reset back to True after the Save)

避免 XL 询问您是否要覆盖使用 Application.DisplayAlerts=False （然后在保存后重置回 True）

回答by LearnCocos2D

Since the OP's question regarding the save dialog is seemingly still open, even though Charles has the answer regarding the "really save? Yes? Are you sure? But that file exists? Anyway? Absolutely sure?" alert, I thought I'll share the complete script with alert messages disabled for completeness sake:

由于 OP 关于保存对话框的问题似乎仍然存在，即使 Charles 有关于“真的保存？是？你确定？但该文件存在？无论如何？绝对确定？”的答案。警报，我想我会分享完整的脚本，为了完整起见，禁用警报消息：

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFileName As String

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With

    Set Sourcewb = ActiveWorkbook
    TempFileName = Sourcewb.FullName + ".csv"

    'Copy the sheet to a new workbook
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook

    'Save the new workbook and close it
    With Destwb
        .SaveAs Filename:=TempFileName, FileFormat:=xlCSV, ConflictResolution:=xlLocalSessionChanges
        .Close SaveChanges:=False
    End With

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
    End With
End Sub