VBA excel Application.getsaveasfilename 错误 13

Question

我正在尝试创建一个宏，让用户将工作簿的备份保存到特定位置。我在下面尝试了我的代码，但收到了错误 13 消息。我不需要将它保存为启用宏的工作簿，但我认为这样会更容易。

Sub openSaveDialog()
'
' gives error 13 message when clicking save
'
Dim saveSuccess As Boolean
Dim fNameRec As String
Dim dateNow As String
Dim saveToDir As String
saveToDir = "Z:\location of save\Old Archive spreadsheets\"
dateNow = Format(Now(), "mmddyyyy")
fNameRec = saveToDir & "BinderArchiveBackup_" & dateNow
Sheets(3).Range("E25") = fNameRec
'check if backed up today
If (Sheets(3).Range("E22") = Date) Then
    MsgBox "backup already saved today no need to save again"
    Exit Sub
End If

'open save as window
saveSuccess = Application.GetSaveAsFilename(InitialFileName:=fNameRec, FileFilter:= _
"Excel Files (*.xlsx)," & "*.xlsx, Macro Enabled" & _
"Workbook (*.xlsm), *xlsm")
'if backup saved, update date of last backup
If saveSuccess Then
    Sheets(3).Range "E22" = Date
    MsgBox "save successful"
End If
'if backup not saved, inform user
If Not saveSuccess Then
    MsgBox "save canceled, please save backup before adding new items to the archive today"
End If
End Sub

我尝试调整的东西

• 仅启用宏的文件过滤器
• 文件过滤器仅用于 Excel 工作簿
• 空白文件过滤器保存为所有文件类型
• 名称末尾带有 .xlsx 的空白文件过滤器
• 初始文件名没有目录，但带有 ChDir，因此无论如何它都会在正确的保存位置打开

任何帮助都会很棒。

---

另存为打开的窗口

Answer 1

GetSaveAsFilename 返回一个Variant，如果用户取消了“另存为”对话框，它将是一个布尔值False，或者如果他们没有取消该对话框，则返回一个包含他们选择的文件名的字符串。

你的台词

Dim saveSuccess As Boolean

如果返回非布尔值将导致问题。所以使用

Dim saveSuccess As Variant

改为。

---

这仍然会给您带来其他问题：

1. Sheets(3).Range "E22" = Date 无效，可能是 Sheets(3).Range("E22") = Date
2. *xlsm 应该是 *.xlsm

3. 您实际上并没有保存文件。你最后的代码应该是这样的：

   If saveSuccess = False Then
       'if backup not saved, inform user
       MsgBox "save canceled, please save backup before adding new items to the archive today"
   Else
       If UCase(Right(saveSuccess, 5)) = ".XLSM" Then
           ActiveWorkbook.SaveAs saveSuccess, xlOpenXMLWorkbookMacroEnabled
           'if backup saved, update date of last backup
           Sheets(3).Range("E22") = Date
           MsgBox "save successful"
       ElseIf UCase(Right(saveSuccess, 5)) = ".XLSX" Then
           ActiveWorkbook.SaveAs saveSuccess, xlOpenXMLWorkbook
           'if backup saved, update date of last backup
           Sheets(3).Range("E22") = Date
           MsgBox "save successful"
       Else
           MsgBox "Unrecognised file extension chosen - backup not created"
       End If
   End If