[SOLVED] VBA workaround for FileDialog in MS Project

VBA workaround for FileDialog in MS Project

I need to be able to import from, and export to, user selected files/locations in MS Project.

I know that the filedialog is not available in Project 2016. Does anyone have a straightforward workaround?

Solution

To ask the user to select a folder use this (from Macro to save selected emails of Outlook in Windows folder)

Function BrowseForFolder(Optional OpenAt As Variant) As Variant
Dim ShellApp As Object
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, OpenAt)

On Error Resume Next
BrowseForFolder = ShellApp.self.Path
On Error GoTo 0

Set ShellApp = Nothing
    Select Case Mid(BrowseForFolder, 2, 1)
        Case Is = ":"
            If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
        Case Is = "\"
            If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
        Case Else
            GoTo Invalid
    End Select
Exit Function

Invalid:
    BrowseForFolder = False
End Function

To ask the user to select a file, use this (from browse files in folder)

Function GetFileDlg(sIniDir, sFilter, sTitle)
    GetFileDlg = CreateObject("WScript.Shell").Exec("mshta.exe ""about:<object id=d classid=clsid:3050f4e1-98b5-11cf-bb82-00aa00bdce0b></object><script>moveTo(0,-9999);function window.onload(){var p=/[^\0]*/;new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).Write(p.exec(d.object.openfiledlg('" & sIniDir & "',null,'" & sFilter & "','" & sTitle & "')));close();}</script><hta:application showintaskbar=no />""").StdOut.ReadAll
End Function

Function BrowseForFile() As Variant
    rep = GetFileDlg(Replace(CurDir, "\", "\\"), "All files (*.*)|*.*", "Pick a file")
    BrowseForFile = rep
End Function