Excel VBA Application.FileDialog(msoFileDialogSaveAs) fails with 0x80010108

0

I have a form in Excel VBA. Upon clicking a command button, a file save as dialog is shown to select a path to save the output (which is to be created later).

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

It works well if there is at least one workbook open in the application.

The problem occurs when there is none: I receive error 0x80010108 at the line indicated.

And the question is: I want that the task of path selection is decoupled from currently open workbooks because it is related to a newly (if at all) created workbook. How can I show a saveas dialog - independently of currently open workbooks?

vba
excel
asked on Stack Overflow Oct 27, 2016 by z32a7ul • edited Jun 2, 2019 by z32a7ul

1 Answer

0

Looks like FileDialog called with msoFileDialogSaveAs is not separated from the ActiveWorkbook on design level, which was a bad choice from MS. So you can select a folder msoFileDialogFolderPicker and supply the name separately or use 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

Update

As requested by @QHarr, I updated the code to work on both 64-bit and 32-bit Windows and both in VBA version 7 and previous VBA versions, according to Microsoft's recommendations (https://docs.microsoft.com/en-us/windows/desktop/winprog/windows-data-types#long-ptr):

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
answered on Stack Overflow Dec 2, 2016 by z32a7ul • edited Apr 1, 2019 by z32a7ul

User contributions licensed under CC BY-SA 3.0