VBA excel Application.getsaveasfilename 错误 13

Posted 2023-05-07

【中文标题】VBA excel Application.getsaveasfilename 错误 13

【英文标题】：VBA excel Application.getsaveasfilename error 13

【发布时间】：2017-07-05 19:59:26

【问题描述】：

我正在尝试创建一个宏，让用户将工作簿的备份保存到特定位置。我在下面尝试了我的代码，但收到了错误 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，因此无论如何它都会在正确的保存位置打开

任何帮助都会很棒。

---

另存为打开的窗口

【参考方案1】：

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

你的台词

Dim saveSuccess As Boolean

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

Dim saveSuccess As Variant

改为。

---

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

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

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

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

【讨论】：

感谢您的帮助。我发现我的问题在于 dateNow 字符串的格式。在放入 MsgBox(dateNow) 后，它显示该字符串列出了用正斜杠分隔月/日/年的数字。当传入文件名时，这会导致另存为函数查找不存在的文件夹。我用 dateNow = month(Date) & day(Date) & year(Date) 替换了它，现在它可以工作了

@NoNels 这听起来很奇怪。我曾想过文件名中的无效字符会导致问题，所以我测试了会发生什么，它所做的只是在显示对话框之前将名称空白。 （而且，尽管它不会出错，但我专门检查了您的 dateNow 变量并确保您没有在其中添加斜杠 - 您使用的是 "mmddyyyy"不会这样做的格式。）

你是对的。我昨天在使用您的修复程序后正在摆弄它时，一定是从mmddyyyy 中删除了引号。我的错。尝试使用我发布的代码，它的行为就像你描述的那样。我对编码还是很陌生，这是我的第一篇文章，所以我猜这是我的错。重要的是代码现在可以工作。 :)