哪里是Outlook的保存FileDialog的？

Question

我工作的一个Outlook插件，需要办事处具体的FileDialog与SharePoint网站进行互操作;通用文件对话框不具有互操作性。我知道，Word和Excel中有Globals.ThisAddIn.Application.Application下get_fileDialog方法，但展望似乎没有。如何启动一个Outlook FileDialog的？它甚至有可能？

Answer 1

Microsoft通用对话框

如果您有COMDLG32.OCX安装（“通用对话框ActiveX控件”），那么你可以使用这个 - 它在这里解释，用一个例子。 （向下滚动刚刚过去题为截图“图2：不要试图在Word中选择多个文件”）。

Answer 2

看来，Outlook的应用程序对象不提供FileDialog。但是一个简单的解决方法，如果你愿意有一个Excel引用，方法是：

Dim fd As FileDialog
Set fd = Excel.Application.FileDialog(msoFileDialogFolderPicker)
Dim folder As Variant    
If fd.Show = -1 Then
    For Each folder In fd.SelectedItems
        Debug.Print "Folder:" & folder & "."
    Next
End If

Answer 3

'Add a "Module". Then add the declarations like this to it.

Option Explicit
Private Declare Function GetOpenFileName _
                Lib "comdlg32.dll" _
                Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    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 Long
    lpTemplateName As String
End Type

Public Function MyOpenFiledialog() As String
    Dim OFName As OPENFILENAME
    OFName.lStructSize = Len(OFName)
    'Set the parent window
    OFName.hwndOwner = Application.hWnd
    'Set the application's instance
    OFName.hInstance = Application.hInstance
    'Select a filter
    OFName.lpstrFilter = "Text Files (*.txt)" + Chr$(0) + "*.txt" + Chr$(0) + "All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0)
    'create a buffer for the file
    OFName.lpstrFile = Space$(254)
    'set the maximum length of a returned file
    OFName.nMaxFile = 255
    'Create a buffer for the file title
    OFName.lpstrFileTitle = Space$(254)
    'Set the maximum length of a returned file title
    OFName.nMaxFileTitle = 255
    'Set the initial directory
    OFName.lpstrInitialDir = "C:\"
    'Set the title
    OFName.lpstrTitle = "Open File - VB Forums.com"
    'No flags
    OFName.flags = 0
    'Show the 'Open File'-dialog
    If GetOpenFileName(OFName) Then
        MsgBox "File to Open: " + Trim$(OFName.lpstrFile)
        MyOpenFiledialog = Trim$(OFName.lpstrFile)
    Else
        MsgBox "Cancel was pressed"
        MyOpenFiledialog = vbNullString
    End If
End Sub 'Usage:
Private Sub Command1_Click()
    Text1.Text = MyOpenFiledialog
End Sub

Answer 4

Public Sub TestFileDialog()
    Dim otherObject As Excel.Application
    Dim fdFolder As office.FileDialog

    Set otherObject = New Excel.Application
    otherObject.Visible = False
    Set fdFolder = otherObject.Application.FileDialog(msoFileDialogFolderPicker)
    fdFolder.Show
    Debug.Print fdFolder.SelectedItems(1)
    otherObject.Quit
    Set otherObject = Nothing
End Sub

Answer 5

Private Sub multiEML2MSG()

Const PR_ICON_INDEX = &H10800003

Dim objPost As Outlook.PostItem
Dim objSafePost As Redemption.SafePostItem
Dim objNS As Outlook.NameSpace
Dim objInbox As Outlook.MAPIFolder


Set objNS = Outlook.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objPost = objInbox.Items.Add(OlItemType.olPostItem)

Set objSafePost = New Redemption.SafePostItem



    Dim xlObj As Excel.Application
    Dim fd As Office.FileDialog

    Set xlObj = New Excel.Application

    Set fd = xlObj.Application.FileDialog(msoFileDialogFolderPicker)
    With fd
        .Title = "Select your PST File"
        .ButtonName = "Ok"
        .Show

        If fd.SelectedItems.Count <> 0 Then
            xDirect$ = fd.SelectedItems(1) & "\"
            xFname$ = Dir(xDirect$, 7)


            licznik = 1
            Do While xFname$ <> ""

            XPathEML = xDirect$ & xFname$
            XPathMSG = Replace(XPathEML, ".eml", ".msg", , , vbTextCompare)
            Debug.Print XPath, Replace(XPath, ".eml", ".msg", , , vbTextCompare)


            objPost.Save
            objSafePost.Item = objPost
            objSafePost.Import XPathEML, Redemption.RedemptionSaveAsType.olRFC822
            objSafePost.MessageClass = "IPM.Note"
            objSafePost.Fields(PR_ICON_INDEX) = none
            objSafePost.SaveAs XPathMSG, Outlook.OlSaveAsType.olMSG



            xFname$ = Dir
            licznik = licznik + 1
        Loop

        End If
    End With

    xlObj.Quit
    Set xlObj = Nothing
    Set objSafePost = Nothing
    Set objPost = Nothing
    Set objInbox = Nothing
    Set objNS = Nothing

End Sub