Application.FileDialog（msoFileDialogSaveAs）用于选择没有打开工作簿的文件夹，失败并显示0x80010108

Question

我在Excel中有一个表单。单击命令按钮后，将显示另存为对话框的文件，以选择保存输出的路径（稍后将创建）。

Private Sub HandleBrowseDestination(edtTarget As MSForms.TextBox)
    If blnEvents <> False Then
        With Application.FileDialog(msoFileDialogSaveAs) ' Error 0x80010108
            .AllowMultiSelect = False
            If .Show = -1 Then
                edtTarget.Value = .SelectedItems(1)
            End If
        End With
    End If
End Sub

如果至少有一个工作簿打开，则可以正常工作。

如果没有，我在指示的行收到错误0x80010108。

我希望路径选择的任务与当前打开的工作簿分离，因为它与新创建的工作簿（如果有的话）相关。

如何选择独立于当前打开的工作簿的文件夹？

Answer 1

看起来使用msoFileDialogSaveAs调用的FileDialog在设计级别上没有与ActiveWorkbook分开，这在MS中是一个糟糕的选择。因此，您可以选择文件夹msoFileDialogFolderPicker并单独提供名称或使用Win API：

Option Explicit

Private Const MAX_PATH As Long = 260

Private Type OPENFILENAME
    lStructSize As Long
    hWndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Private Const OFN_ALLOWMULTISELECT = &H200
Private Const OFN_CREATEPROMPT = &H2000
Private Const OFN_ENABLEHOOK = &H20
Private Const OFN_ENABLETEMPLATE = &H40
Private Const OFN_ENABLETEMPLATEHANDLE = &H80
Private Const OFN_EXPLORER = &H80000
Private Const OFN_EXTENSIONDIFFERENT = &H400
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_LONGNAMES = &H200000
Private Const OFN_NOCHANGEDIR = &H8
Private Const OFN_NODEREFERENCELINKS = &H100000
Private Const OFN_NOLONGNAMES = &H40000
Private Const OFN_NONETWORKBUTTON = &H20000
Private Const OFN_NOREADONLYRETURN = &H8000
Private Const OFN_NOTESTFILECREATE = &H10000
Private Const OFN_NOVALIDATE = &H100
Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFN_PATHMUSTEXIST = &H800
Private Const OFN_READONLY = &H1
Private Const OFN_SHAREAWARE = &H4000
Private Const OFN_SHAREFALLTHROUGH = 2
Private Const OFN_SHARENOWARN = 1
Private Const OFN_SHAREWARN = 0
Private Const OFN_SHOWHELP = &H10

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Boolean

Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Boolean

Public Function GetSaveFileNameVba(Optional strInitialDir As String = vbNullString, Optional strTitle As String = vbNullString) As String
    Dim ofn As OPENFILENAME
    ofn.lStructSize = Len(ofn)
    ofn.lpstrFile = vbNullChar & Space(MAX_PATH - 1)
    ofn.nMaxFile = MAX_PATH
    ofn.lpstrInitialDir = strInitialDir
    ofn.lpstrTitle = strTitle
    ofn.flags = 0
    If GetSaveFileName(ofn) <> False Then
        GetSaveFileNameVba = Left(ofn.lpstrFile, InStr(ofn.lpstrFile, vbNullChar) - 1)
    End If
End Function

Public Function GetOpenFileNameVba(Optional strInitialDir As String = vbNullString, Optional strTitle As String = vbNullString) As String
    Dim ofn As OPENFILENAME
    ofn.lStructSize = Len(ofn)
    ofn.lpstrFile = vbNullChar & Space(MAX_PATH - 1)
    ofn.nMaxFile = MAX_PATH
    ofn.lpstrInitialDir = strInitialDir
    ofn.lpstrTitle = strTitle
    ofn.flags = OFN_FILEMUSTEXIST
    If GetOpenFileName(ofn) <> False Then
        GetOpenFileNameVba = Left(ofn.lpstrFile, InStr(ofn.lpstrFile, vbNullChar) - 1)
    End If
End Function

<强>更新

根据微软的建议（https://docs.microsoft.com/en-us/windows/desktop/winprog/windows-data-types#long-ptr，根据@QHarr的要求，我更新了代码以适用于64位和32位Windows以及VBA版本7和以前的VBA版本。 ）：

Option Explicit

Private Const MAX_PATH As Long = 260

#If VBA7 Then
Private Type OPENFILENAME
    lStructSize As Long
    hWndOwner As LongPtr
    hInstance As LongPtr
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As LongPtr
    lpfnHook As LongPtr
    lpTemplateName As String
End Type
#Else
Private Type OPENFILENAME
    lStructSize As Long
    hWndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type
#End If

Private Const OFN_ALLOWMULTISELECT As Long = &H200
Private Const OFN_CREATEPROMPT As Long = &H2000
Private Const OFN_ENABLEHOOK As Long = &H20
Private Const OFN_ENABLETEMPLATE As Long = &H40
Private Const OFN_ENABLETEMPLATEHANDLE As Long = &H80
Private Const OFN_EXPLORER As Long = &H80000
Private Const OFN_EXTENSIONDIFFERENT As Long = &H400
Private Const OFN_FILEMUSTEXIST As Long = &H1000
Private Const OFN_HIDEREADONLY As Long = &H4
Private Const OFN_LONGNAMES As Long = &H200000
Private Const OFN_NOCHANGEDIR As Long = &H8
Private Const OFN_NODEREFERENCELINKS As Long = &H100000
Private Const OFN_NOLONGNAMES As Long = &H40000
Private Const OFN_NONETWORKBUTTON As Long = &H20000
Private Const OFN_NOREADONLYRETURN As Long = &H8000
Private Const OFN_NOTESTFILECREATE As Long = &H10000
Private Const OFN_NOVALIDATE As Long = &H100
Private Const OFN_OVERWRITEPROMPT As Long = &H2
Private Const OFN_PATHMUSTEXIST As Long = &H800
Private Const OFN_READONLY As Long = &H1
Private Const OFN_SHAREAWARE As Long = &H4000
Private Const OFN_SHAREFALLTHROUGH As Long = 2
Private Const OFN_SHARENOWARN As Long = 1
Private Const OFN_SHAREWARN As Long = 0
Private Const OFN_SHOWHELP As Long = &H10

#If VBA7 Then
Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Boolean
#Else
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Boolean
#End If

#If VBA7 Then
Private Declare PtrSafe Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Boolean
#Else
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Boolean
#End If

Public Function GetSaveFileNameVba(Optional strInitialDir As String = vbNullString, Optional strTitle As String = vbNullString) As String
    Dim ofn As OPENFILENAME
    ofn.lStructSize = Len(ofn)
    ofn.lpstrFile = vbNullChar & Space(MAX_PATH - 1)
    ofn.nMaxFile = MAX_PATH
    ofn.lpstrInitialDir = strInitialDir
    ofn.lpstrTitle = strTitle
    ofn.flags = 0
    If GetSaveFileName(ofn) <> False Then
        GetSaveFileNameVba = Left(ofn.lpstrFile, InStr(ofn.lpstrFile, vbNullChar) - 1)
    End If
End Function

Public Function GetOpenFileNameVba(Optional strInitialDir As String = vbNullString, Optional strTitle As String = vbNullString) As String
    Dim ofn As OPENFILENAME
    ofn.lStructSize = Len(ofn)
    ofn.lpstrFile = vbNullChar & Space(MAX_PATH - 1)
    ofn.nMaxFile = MAX_PATH
    ofn.lpstrInitialDir = strInitialDir
    ofn.lpstrTitle = strTitle
    ofn.flags = OFN_FILEMUSTEXIST
    If GetOpenFileName(ofn) <> False Then
        GetOpenFileNameVba = Left(ofn.lpstrFile, InStr(ofn.lpstrFile, vbNullChar) - 1)
    End If
End Function