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?
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 1
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://learn.microsoft.com/en-us/windows/desktop/winprog/windows-data-types#long-ptr):
Update 2
As noticed by @JohnM, LenB is needed instead of Len in 64-bit; I updated the code accordingly.
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 = LenB(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 = LenB(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