MS Project 中 FileDialog 的 VBA 解决方法

如何解决MS Project 中 FileDialog 的 VBA 解决方法

我需要能够从 MS Project 中的用户选择的文件/位置导入和导出。我知道文件对话框在 Project 2016 中不可用。有人有简单的解决方法吗？

谢谢！

解决方法

要让用户选择一个文件夹，请使用它（来自 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",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

要让用户选择一个文件，使用这个（来自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