Excel VBA Application.FileDialog（msoFileDialogSaveAs）失敗，0x80010108

Question

我在Excel VBA中有一個窗體。在單擊一個命令按鈕時，將顯示一個文件另存爲對話框，以選擇保存輸出的路徑（稍後將創建該路徑）。

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。

問題是：我希望路徑選擇的任務與當前打開的工作簿分離，因爲它與新創建的工作簿（如果完全相關）有關。如何顯示saveas對話框 - 獨立於當前打開的工作簿？

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