vbavisiofiledialog

open a fileDialog in visio vba


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?


Solution

  • 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