Application.GetSaveAsFilename(InitialFileName:=Range("O26") 有时会出现一个空白对话框

我有一个子程序将我的文档保存为二进制工作簿。 （来自堆栈溢出。）

我尝试从单元格中获取值用作文件名。

通常它工作得很好，我不明白为什么有时不能。

我在单元格 O26 中的数据始终是文本字符串。

Dim fname As Variant
Dim FileFormatValue As Long

fname = Application.GetSaveAsFilename(InitialFileName:=Range("O26"), filefilter:= _
  " Excel Macro Free Workbook (*.xlsx), *.xlsx," & _
  " Excel Macro Enabled Workbook (*.xlsm), *.xlsm," & _
  " Excel 2000-2003 Workbook (*.xls), *.xls," & _
  " Excel Binary Workbook (*.xlsb), *.xlsb", _
  FilterIndex:=4, Title:="Save as xlsb")
'Find the correct FileFormat that match the choice in the "Save as type" list
Select Case LCase(Right(fname, Len(fname) - InStrRev(fname, ".", , 1)))
    Case "xls": FileFormatValue = 56
    Case "xlsx": FileFormatValue = 51
    Case "xlsm": FileFormatValue = 52
    Case "xlsb": FileFormatValue = 50
    Case Else: FileFormatValue = 0
End Select

If fname = isblank Then
    MsgBox "Project Not Saved!"
    Exit Sub
End If
         
ActiveWorkbook.SaveAs fname, FileFormat:= _
  FileFormatValue, CreateBackup:=False

获取另存为文件名

• 你的代码的明星是Application.GetSaveAsFilename 方法 （Excel）|微软 文档 https://learn.microsoft.com/en-us/office/vba/api/excel.application.getsaveasfilename.

三句话

• 显示标准Save As对话框并从中获取文件名 用户无需实际保存任何文件。

• （该方法返回选择的文件名或输入的名称 用户。返回的名称可能包括路径规范）。 退货False如果用户取消对话框。

• When InitialFilename用来带扩展名 and a 过滤器是 应用, 该扩展名必须与过滤器扩展名匹配, 否则有效InitialFilename显示在对话框中 box 将是一个空字符串。

问题

• 无需在点上区分大小写（.):
  Not InStrRev(fName, ".", , 1), but InStrRev(fName, ".").

• 没有isblank在VBA中（无论如何都是小写）。ISBLANK是一个 Excel 函数。第二句话解决了这个问题（False).

• 第三句话基本上是说你必须使用 不带扩展名或具有指定扩展名的文件名FilterIndex这是xlsb在你的情况下。如果您需要有一个 具有另一个扩展名的文件，那么您可以使用以下组合Left和新创建的getExtension获取不带文件名的文件名 扩大。

The Code

Option Explicit

' Gets the extension (the string behind the last dot) of a filename.
Function getExtension(ByVal fName As String) As String
    getExtension = LCase(Right(fName, Len(fName) - InStrRev(fName, ".")))
End Function

' DisplayAlerts Version
Sub getSaveFileDA()

    Dim fName As Variant
    Dim FileFormatValue As Long

    With Application
        fName = .GetSaveAsFilename( _
                InitialFileName:=Range("O26").Value, FileFilter:= _
                " Excel Macro Free Workbook (*.xlsx), *.xlsx," & _
                " Excel Macro Enabled Workbook (*.xlsm), *.xlsm," & _
                " Excel 2000-2003 Workbook (*.xls), *.xls," & _
                " Excel Binary Workbook (*.xlsb), *.xlsb", _
                FilterIndex:=4, Title:="Save as .xlsb")
    End With

    ' Find the correct FileFormat that matches the choice
    ' in the "Save as type" list.
    Select Case getExtension(fName)
        Case "xls": FileFormatValue = 56
        Case "xlsx": FileFormatValue = 51
        Case "xlsm": FileFormatValue = 52
        Case "xlsb": FileFormatValue = 50
        Case Else: FileFormatValue = 0
    End Select

    If fName = False Then         ' When user selects Cancel.
        MsgBox "Project Not Saved!"
        Exit Sub
    End If

    ' If fName exists then Excel will complain about it and when you
    ' press No or Cancel, an error will occur. To prevent this you can
    ' use Application.DisplayAlerts but keep in mind that then the file
    ' will be overwritten without the confirmation dialog popping up.
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs fName, FileFormat:= _
                          FileFormatValue, CreateBackup:=False
    Application.DisplayAlerts = True

    MsgBox "Project successfully saved.", vbInformation

End Sub

' On Error Resume Next Version
Sub getSaveFileOE()

    Dim fName As Variant
    Dim FileFormatValue As Long

    With Application
        fName = .GetSaveAsFilename( _
                InitialFileName:=Range("O26").Value, FileFilter:= _
                " Excel Macro Free Workbook (*.xlsx), *.xlsx," & _
                " Excel Macro Enabled Workbook (*.xlsm), *.xlsm," & _
                " Excel 2000-2003 Workbook (*.xls), *.xls," & _
                " Excel Binary Workbook (*.xlsb), *.xlsb", _
                FilterIndex:=4, Title:="Save as .xlsb")
    End With

    ' Find the correct FileFormat that matches the choice
    ' in the "Save as type" list.
    Select Case getExtension(fName)
        Case "xls": FileFormatValue = 56
        Case "xlsx": FileFormatValue = 51
        Case "xlsm": FileFormatValue = 52
        Case "xlsb": FileFormatValue = 50
        Case Else: FileFormatValue = 0
    End Select

    If fName = False Then GoTo NotSaved ' When user selects Cancel.

    On Error Resume Next
    ActiveWorkbook.SaveAs fName, FileFormat:= _
                          FileFormatValue, CreateBackup:=False

    If Err.Number <> 0 Then
        On Error GoTo 0
        GoTo NotSaved
    Else
        On Error GoTo 0
        MsgBox "Project successfully saved.", vbInformation
    End If

    Exit Sub

NotSaved:
    MsgBox "Project Not Saved!", vbExclamation

End Sub