VBA代码保存为在outlook文件夹路径中是抛出运行时错误



每月自动将Outlook收件箱中的特定电子邮件保存在硬盘驱动器上。

我希望能够每月自动保存Outlook收件箱中的特定电子邮件,这些电子邮件具有关键字"批准"或"已批准",并且不区分大小写并且由特定发件人发送。

  1. 我在为另存为提供的文件夹路径中收到错误
  2. 我还想调整代码以便能够每月工作(例如,在每月收件箱中发送电子邮件的日期之后运行宏 - 例如每月的第 3 周)
  3. 我想调整代码以仅保存来自特定发件人,特定主题和特定内容的电子邮件
Option Explicit
Sub outlooksavefile()
Dim o As Outlook.Application
Set o = New Outlook.Application
Dim ons As Outlook.Namespace
Set ons = o.GetNamespace("mapi")
Dim fol As Outlook.Folder
Set fol = ons.GetDefaultFolder(olFolderInbox).Folders("Test")
Dim omail As Outlook.MailItem
Set omail = o.CreateItem(olMailItem)
For Each omail In fol.Items
omail.SaveAs "H:2019" & omail.Subject & ".msg"
Next omail
End Sub

您有责任确保文件名不包含无效字符(如":"或"\") - 您的代码按原样使用消息主题。

您必须通过检查其Class来确保文件夹中找到的每个项目都是一封电子邮件。

关于错误:也许您不被允许在那里写字,或者 - 更有可能 - 电子邮件主题中的某些字符在您的文件系统中被禁止。我添加了一些代码来替换禁止的字符。

如果您循环访问每封电子邮件,则无需通过之前CreateItem生成额外的新电子邮件。

Option Explicit
Sub outlooksavefile()
Dim o As Outlook.Application
Set o = New Outlook.Application
Dim ons As Outlook.NameSpace
Set ons = o.GetNamespace("mapi")
Dim fol As Outlook.Folder
Set fol = ons.GetDefaultFolder(olFolderInbox).Folders("Test")
Dim omail As Object
For Each omail In fol.Items
If omail.Class = olMail Then  ' olMail = 43
Debug.Print omail.Sender
Debug.Print omail.Subject
Debug.Print omail.Sender
Debug.Print Left(omail.Body, 20)
omail.SaveAs Environ("USERPROFILE") & "Documents" & _
AllowedChars(omail.Subject) & ".msg", olMSG ' olMSG = 3
End If
Next omail
End Sub
Private Function AllowedChars(ByRef s As String) As String
Dim i As Long
Dim myChar As String
AllowedChars = s
For i = 1 To Len(AllowedChars)
myChar = Mid$(AllowedChars, i, 1)
If myChar Like "[<>:""/|?*]" Or Asc(myChar) < 32 Then
Mid$(AllowedChars, i, 1) = "_"
End If
Next i
End Function

关于您的问题 2:请在运行完此内容后提出另一个问题。

关于问题3:我添加了一些调试信息以查看发件人和其他电子邮件项目的存储方式。在此基础上,您可以生成一些 If 条件。

最新更新