2

添付ファイルをSaveAsファイルダイアログで保存したい。VBAとOutlookでこれを行うことは可能ですか？

4

3 に答える 3

1

Outlookでファイルダイアログを開くことはできないと思います。

私が使用した醜いが迅速で機能的な回避策は、Excelのインスタンスを一時的に開き、その GetSaveAsFilenameメソッドを使用することです。

Set xlApp = CreateObject("Excel.application")
xlApp.Visible = False
strSaveAsFilename = xlApp.GetSaveAsFilename
xlApp.Quit
Set xlApp = Nothing

次に、あなたは言うことができますMyAttachment.SaveAsFile(strSaveAsFilename)。

Excelが必ずしもインストールされていない場合は、WordとFileDialogメソッドを使用して同様のトリックを実行できます（WordにはGetSaveAsFilenameがありません）。例については、FileDialogのVBAヘルプを参照してください。

おそらくもっとエレガントな解決策がありますが、上記はうまくいくでしょう...

于 2011-02-18T09:42:25.410 に答える
1

関数を忘れないでくださいBrowseForFolder：

Function BrowseForFolder(Optional OpenAt As String) As String 

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 

Select Case Mid(BrowseForFolder, 2, 1) 
Case Is = ":" 
    If Left(BrowseForFolder, 1) = ":" Then 
        BrowseForFolder = "" 
    End If 
Case Is = "\" 
    If Not Left(BrowseForFolder, 1) = "\" Then 
        BrowseForFolder = "" 
    End If 
Case Else 
    BrowseForFolder = "" 
End Select 

ExitFunction: 

Set ShellApp = Nothing 

End Function
于 2015-01-08T17:45:48.243 に答える
0

この動作をシミュレートする方法は2つあります（ここではOutlook 2003を想定しています）。

ファイルを使用»添付ファイルを保存

このコードは、プログラムでファイルメニューの「添付ファイルの保存」メニュー項目を呼び出します。以下の3つの補助機能が必要であり、同じプロジェクトに貼り付ける必要があります。添付ファイル付きの電子メールを選択または開き、SaveAttachments手順を実行します。

Sub SaveAttachments()

Dim obj As Object
Dim msg As Outlook.mailItem
Dim insp As Outlook.Inspector

Set obj = GetCurrentItem
If TypeName(obj) = "MailItem" Then
  Set msg = obj
  Set insp = msg.GetInspector
  With insp
    .Display
    ' execute the File >> Save Attachments control
    .CommandBars.FindControl(, 3167).Execute
    .Close olDiscard ' or olPromptForSave, or olSave
  End With
End If

End Sub

Function GetCurrentItem() As Object
  Select Case True
  Case IsExplorer(Application.ActiveWindow)
    Set GetCurrentItem = ActiveExplorer.Selection.item(1)
  Case IsInspector(Application.ActiveWindow)
    Set GetCurrentItem = ActiveInspector.CurrentItem
  End Select
End Function
Function IsExplorer(itm As Object) As Boolean
  IsExplorer = (TypeName(itm) = "Explorer")
End Function
Function IsInspector(itm As Object) As Boolean
  IsInspector = (TypeName(itm) = "Inspector")
End Function

複数の添付ファイルがある場合は、保存ダイアログが表示される前に、保存する添付ファイルを選択するように求められることに注意してください。

複数のファイルで添付ファイルを保存する

BrowserForFolderを使用する

VBAXにあるBrowseForFolder関数を使用しています。これにより、Shell.ApplicationのBrowseForFolderダイアログが表示されます。

シェルアプリはフォルダーを参照します

添付ファイル付きの電子メールを選択または開き、SaveAttachments手順を実行します。ダイアログでフォルダを選択すると、電子メールへのすべての添付ファイルが選択したフォルダに保存されます。

Sub SaveAttachments()

  Dim folderToSave As String
  Dim obj As Object
  Dim msg As Outlook.mailItem
  Dim msgAttachs As Outlook.attachments
  Dim msgAttach As Outlook.Attachment

  folderToSave = BrowseForFolder

  If folderToSave <> "False" Then

    Set obj = GetCurrentItem
    If TypeName(obj) = "MailItem" Then
      Set msg = obj
      Set msgAttachs = msg.attachments

      For Each msgAttach In msgAttachs
        msgAttach.SaveAsFile folderToSave & "\" & msgAttach.FileName
      Next msgAttach
    End If

  End If

End Sub

Function GetCurrentItem() As Object
  Select Case True
  Case IsExplorer(Application.ActiveWindow)
    Set GetCurrentItem = ActiveExplorer.Selection.item(1)
  Case IsInspector(Application.ActiveWindow)
    Set GetCurrentItem = ActiveInspector.CurrentItem
  End Select
End Function
Function IsExplorer(itm As Object) As Boolean
  IsExplorer = (TypeName(itm) = "Explorer")
End Function
Function IsInspector(itm As Object) As Boolean
  IsInspector = (TypeName(itm) = "Inspector")
End Function
于 2012-07-06T18:12:20.803 に答える