I'm coding macros in vba Word and on visio 2013. I wanted to open a fileDialog so that the user can choose where to save his file.
I succeded in word, but in visio it doesn't to work the same.
I wrote this in word:
Dim dlg As FileDialog
Dim strPath As String
'Boite de dialogue pour choisir où enregistrer son fichier
Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
With dlg
.InitialFileName = Application.ActiveDocument.Path
.AllowMultiSelect = False
.Title = "Choisir le répertoire d'enregistrement"
.Show
End With
strPath = dlg.SelectedItems(1)
but it doesn't work in visio. Can someone help me do the same in visio?
If you don't want to use other office application, you can use winapi OpenFileDialog
to achieve similar behavior, but it won't as easy as with .FileDialog
.
See more details here: Open File Dialog in Visio
The module source code (compatible with Visio 2010 and above, i.e. with editions which have x64 version). For the original source code, compatible with previous versions, chech the above link.
'// This is code that uses the Windows API to invoke the Open File
'// common dialog. It is used by users to choose a file
Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (OFN As OPENFILENAME) As Boolean
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 Long
lpfnHook As LongPtr
lpTemplateName As String
End Type
Public Sub OpenFile(ByRef filePath As String, _
ByRef cancelled As Boolean)
Dim OpenFile As OPENFILENAME
Dim lReturn As Long
Dim sFilter As String
' On Error GoTo errTrap
OpenFile.lStructSize = LenB(OpenFile)
'// Sample filter:
'// "Text Files (*.txt)" & Chr$(0) & "*.sky" & Chr$(0) & "All Files (*.*)" & Chr$(0) & "*.*"
sFilter = "All Files (*.*)" & Chr(0) & "*.*"
OpenFile.lpstrFilter = sFilter
OpenFile.nFilterIndex = 1
OpenFile.lpstrFile = String(257, 0)
OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
OpenFile.lpstrFileTitle = OpenFile.lpstrFile
OpenFile.nMaxFileTitle = OpenFile.nMaxFile
OpenFile.lpstrInitialDir = ThisDocument.Path
OpenFile.lpstrTitle = "Find Excel Data Source"
OpenFile.flags = 0
lReturn = GetOpenFileName(OpenFile)
If lReturn = 0 Then
cancelled = True
filePath = vbNullString
Else
cancelled = False
filePath = Trim(OpenFile.lpstrFile)
filePath = Replace(filePath, Chr(0), vbNullString)
End If
Exit Sub
errTrap:
Exit Sub
Resume
End Sub