vba 使用单元格中的标题将工作簿保存在当前目录中

Save Workbook in current directory with title from cell

提问by mlun

I download files where I need to rename them based on the name contained in cell A1. The file is already saved in the current directory, so what I am after is only to save to the current directory with the filename in call A1 and the extension ".xls"

我下载需要根据单元格 A1 中包含的名称重命名的文件。该文件已经保存在当前目录中，所以我所要做的只是将文件名保存到当前目录，调用 A1 中的文件名和扩展名“.xls”

Tried this code:

试过这个代码：

Sub SaveToRelativePath()
    Dim relativePath As String, sname As String
    sname = ActiveWorkbook.Worksheets(1).Range("A1") & ".xls"
    relativePath = Application.ActiveWorkbook.Path & "\" & sname
    ActiveWorkbook.SaveAs Filename:=relativePath
End Sub

But the debugger reports an error on the last line: ActiveWorkbook.SaveAs Filename:=relativePath

但是调试器在最后一行报错：ActiveWorkbook.SaveAs Filename:=relativePath

Any clues to how this could be done?

关于如何做到这一点的任何线索？

回答by Peter L.

The error is not specified, but in case you see:

未指定错误，但如果您看到：

It means you try to save a workbook with the above code as "XLS" (actually, not exactly, see below) - and that means a macro-freeformat. Excel warns you you'll lose the code.

这意味着您尝试将具有上述代码的工作簿保存为“XLS”（实际上，不完全是，请参见下文）-这意味着无宏格式。Excel 警告您将丢失代码。

One more issue - regardless of extension you code will save the book as defaultformat for the Excel version you use (and that is XLSX or xlOpenXMLWorkbookfor 2007 and perhaps future versions, I have 2007). As a result, you'll get on the saved file opening something like that:

另一个问题 - 无论您编码的扩展名如何，都会将本书保存为您使用的 Excel 版本的默认格式（即 XLSX 或xlOpenXMLWorkbook2007 年，也可能是未来版本，我有 2007 年）。结果，您将打开保存的文件，如下所示：

Solutions:

解决方案：

1. To avoid the 1st warning - save your initial workbook (i.e. that one where you keep the VBA code) as Macro-Enabledbefore running the macro.
2. Add proper format description to Save method - in your case that will be FileFormat:=xlExcel8- thus you'll get true XLS.

3. One more thing - to avoid aby compatibility alerts when saving file as XLS, add the .CheckCompatibility = Falsebefore saving. resulting code should be smth like that:

   Sub SaveToRelativePath()
       Dim relativePath As String, sname As String
       sname = ActiveWorkbook.Worksheets(1).Range("A1") & ".xls"
       relativePath = Application.ActiveWorkbook.Path & "\" & sname
       Application.DisplayAlerts = False
       ActiveWorkbook.CheckCompatibility = False
       ActiveWorkbook.SaveAs Filename:=relativePath, FileFormat:=xlExcel8
       Application.DisplayAlerts = True
   End Sub
   

1. 为了避免第一个警告 -在运行宏之前，将您的初始工作簿（即保存 VBA 代码的那个）保存为启用宏。
2. 将正确的格式描述添加到 Save 方法 - 在你的情况下FileFormat:=xlExcel8- 这样你就会得到真正的 XLS。

3. 还有一件事 - 为避免在将文件保存为 XLS 时出现兼容性警报，请在保存.CheckCompatibility = False之前添加。结果代码应该是这样的：

   Sub SaveToRelativePath()
       Dim relativePath As String, sname As String
       sname = ActiveWorkbook.Worksheets(1).Range("A1") & ".xls"
       relativePath = Application.ActiveWorkbook.Path & "\" & sname
       Application.DisplayAlerts = False
       ActiveWorkbook.CheckCompatibility = False
       ActiveWorkbook.SaveAs Filename:=relativePath, FileFormat:=xlExcel8
       Application.DisplayAlerts = True
   End Sub
   

However be careful - such construction will silently overwrite any existing file. Hope that was somehow helpful.

但是要小心——这样的结构会悄悄地覆盖任何现有的文件。希望这在某种程度上有所帮助。