VBA MS Project 中 FileDialog 的解决方法

Question

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

谢谢！

Answer 1

要求用户select一个文件夹使用这个（来自）

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

要让用户select一个文件，使用这个（来自）

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=/[^[=11=]]*/;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

VBA MS Project 中 FileDialog 的解决方法

VBA workaround for FileDialog in MS Project

vba

ms-project

filedialog