Outlookの保存FileDialogはどこですか？

Question

私は、Office専用のFileDialogをSharepointサイトと相互運用する必要があるOutlookアドインで作業しています。共通ファイルダイアログには相互運用性がありません。私は、WordとExcelの両方がGlobals.ThisAddIn.Application.Applicationの下にget_fileDialogメソッドを持っているが、Outlookはそう思わないことを知っている。 Outlook FileDialogを起動するにはどうすればよいですか？それも可能ですか？

Answer 1

Microsoft Common Dialog

あなたがCOMDLG32.OCX（ "共通ダイアログのActiveXコントロール"）がインストールされている場合は、これを使用することができます - それは、例を挙げて、ここでは説明しています。 （「図2：Wordで複数のファイルを選択しないでください！」というスクリーンショットの直後までスクロールします）。

Answer 2

'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 3

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 4

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 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