你可以有一个Excelmacros自动保存副本为CSV

加载一个XLS文件对于一个快速的应用程序来说是一件痛苦的事情（我们知道如何做，但是这不值得花时间，特别是在C ++中），所以我们要采取简单的方法用户导出CSV副本。 但是，为了节省他们的麻烦，我想知道如果我们可以有一个macros将自动保存一个CSV版本，每当他们在Excel 2007中保存XLS（X）？

更新：根据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 

这个工程除了我不能强制保存CSV，而不是问我是否要覆盖，甚至在添加ConflictResolution:=xlLocalSessionChanges

Answer 1

原始版本：

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

通过以下方式replacemacros：

 Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) ActiveWorkbook.SaveCopyAs ActiveWorkbook.FullName + ".csv" End Sub 

这将复制CSV扩展名。

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

编辑版本：

看到下面的评论后，我再次testing了一遍。 奇怪的是，它没有像第一次那样工作。 这是一个固定的版本。 再次，在macros编辑器的“This Workbook”部分：

 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 

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

Answer 2

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

Answer 3

由于OP关于保存对话框的问题似乎仍然是开放的，即使查尔斯有关于“真正的保存？是的？你确定吗？”的答案，但是这个文件存在吗？无论如何，绝对可以肯定吗？ 警惕，我想我会分享完整的脚本警告消息完整性：

 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