2

我想用SaveAs文件对话框保存邮件附件。是否可以使用 VBA 和 Outlook 做到这一点？

4

3 回答 3

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 回答
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 回答
0

有两种方法可以模拟这种行为（我假设这里是 Outlook 2003）：

使用文件 » 保存附件

此代码将以编程方式调用文件菜单上的“保存附件”菜单项。下面的三个辅助功能是必需的，应该粘贴到同一个项目中。选择或打开带有附件的电子邮件并运行该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

请注意，如果有多个附件，系统会提示您选择要保存的附件，然后才会显示保存对话框：

保存带有多个文件的附件

使用浏览文件夹

我使用 VBAX 上的BrowseForFolder函数。这将显示 Shell.Application 的 BrowseForFolder 对话框：

shell 应用程序浏览文件夹

选择或打开带有附件的电子邮件并运行该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 回答