我想使用SaveAs
文件对话框保存邮件附件。是否可以使用VBA和Outlook执行此操作?
答案 0 :(得分: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帮助。
那里可能有一个更优雅的解决方案,但上面会有效......
答案 1 :(得分: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
答案 2 :(得分: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对话框:
选择或打开包含附件的电子邮件,然后运行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