我可以阅读代码，并稍作调整。
我可以访问公司电子邮件（例如invoice@rr.com）。
我想要查看invoice@rr.com收件箱中所有新邮件的代码（即使即使Outlook未打开也能正常工作，但最好的方法是手动单击宏会让我很高兴）并回复所有人（带有附件） ），何时：
除此之外，代码还需要将邮件移至名为“发送回”的子文件夹。
我一直在阅读论坛，问题之一是签名中的图片也算作附件。
首先请Tony寻求帮助：
Sub reply()
'still need to get rid of all the stuff i dont use below (up to the *) but still not sure about the code so I left it here for now
Dim olInspector As Outlook.Inspector
Dim olDocument As Outlook.DocumentItem
Dim olSelection As Outlook.Selection
Dim olReply As MailItem
Dim olAtt As Attachment
Dim olFileType As String
Dim AttachCount As Long
Dim AttachDtl() As String
Dim ExcelWkBk As Excel.Workbook
Dim FileName As String
Dim FolderTgt As MAPIFolder
Dim HtmlBody As String
Dim InterestingItem As Boolean
Dim InxAttach As Long
Dim InxItemCrnt As Long
Dim PathName As String
Dim ReceivedTime As Date
Dim RowCrnt As Long
Dim SenderEmailAddress As String
Dim SenderName As String
Dim Subject As String
Dim TextBody As String
Dim myDestFolder As Outlook.Folder
'*
Set myDestFolder = Session.Folders("Outlook Data File").Folders("replied")
Set Myselect = Outlook.ActiveExplorer.Selection '(i use this in my test to only process selected test mails)
'Set FolderTgt = Session.Folders("invoice@rr.com").Folders("Inbox") ***(this will replace the code above)
For InxItemCrnt = Myselect.Items.Count To 1 Step -1 '(myselect = foldertgt in live)
With Myselect.Items.Item(InxItemCrnt) '(myselect = foldertgt in live)
'still need a workaround for mail with (1 .PDF and 1 .ICF) or (1 .PDF and 1 .XML)
'those combinations are the only combinations when more then one attachment is allowed
'1st filter
If AttachCount = 0 Then 'no attachment = reply
Reply0
.move myDestFolder
Else
'2nd filter
If AttachCount > 1 Then 'more then one attachment = reply
Reply1
.move myDestFolder
Else
'3rd filter
If InStr(Subject, "Reminder") = 0 Then 'reminders need to go to a different mailbox
Reply2
.move myDestFolder
Else
'4th filter
Select Case olFileType
Case ".pdf, .icf, .xml"
If olFileType = LCase$(Right$(olAtt.FileName, 4)) Then
Exit Sub 'if attachment = pdf or ICF then this sub can exit
Else
Reply3 'all mails with incorrect files
.move myDestFolder
End Select
End If
End If
End If
End If
End With
'replies below
Reply0:
Set olReply = Item.Reply '// Reply if no attachment found
olReply.Body = "this is an automatic generated mail." & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & ".... insert text...." 'still need to insert some text
olReply.Send
Reply1:
Set olReply = Item.Reply '// Reply more then one attachment
olReply.Body = "this is an automatic generated mail." & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & ".... insert text...." 'still need to insert some text
olReply.Send
Reply2:
Set olReply = Item.Reply '// Reply reminders need to go to reminder@rr.com
olReply.Body = "this is an automatic generated mail." & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & ".... insert text...." 'still need to insert some text
olReply.Send
Reply3:
Set olReply = Item.Reply '// Reply not correct file
olReply.Body = "this is an automatic generated mail." & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & ".... insert text...." 'still need to insert some text
olReply.Send
Next
Set olInspector = Nothing
Set olDocument = Nothing
Set olSelection = Nothing
Set olAtt = Nothing
End Sub
第二次尝试获得Tony的更多帮助：（注意：我是荷兰人，所以某些代码中有荷兰语，我会在代码后用英语解释，基本上是从答案，所有功劳都归托尼所有）
Sub reply()
Dim Fso As New FileSystemObject
Dim DiagFile As TextStream
Dim FldrInvInbox As MAPIFolder
Dim InxA As Long
Dim InxItemCrnt As Long
Dim NumIcfAttach As Long
Dim NumPdfAttach As Long
Dim NumXmlAttach As Long
Dim NumDocAttach As Long
Dim NumDoxAttach As Long
Dim PathDiag As String
Dim Pos As Long
Dim ProcessThisEmail As Boolean
Dim Subject As String
Dim ReminderInBody As Boolean
Dim ReminderInSubject As Boolean
Dim ReminderInBody1 As Boolean
Dim ReminderInSubject1 As Boolean
Set FldrInvInbox = Session.Folders("invoice@rr.com").Folders("Postvak IN") 'Postvak IN = Inbox)
PathDiag = "z:\VBA test" 'location for diagnostics report
Set DiagFile = Fso.CreateTextFile(PathDiag & "\Diag.txt", True, False)
For InxItemCrnt = FldrInvInbox.Items.Count To 1 Step -1
With FldrInvInbox.Items.Item(InxItemCrnt)
' It is unlikely an Inbox will contain anything but emails
' but it does no harm to check
If .Class = olMail Then
' Extract information that will identify if this email is to be processed
ProcessThisEmail = True ' Assume True until find otherwise
'Below i'm looking for reminder, payment reminder and other similiar text in subject, dutch words are betalingsherinnering and openstaande posten
If InStr(1, LCase(.Subject), "betalingsherinnering") = 0 Then
ReminderInSubject = False
Else
ReminderInSubject = True
ProcessThisEmail = False
End If
If InStr(1, LCase(.Subject), "openstaande posten") = 0 Then
ReminderInSubject1 = False
Else
ReminderInSubject1 = True
ProcessThisEmail = False
End If
'Below i'm looking for reminder, payment reminder and other similiar text in mail, dutch words are betalingsherinnering and openstaande posten
If InStr(1, LCase(.Body), "betalingsherinnering") = 0 Then
ReminderInBody = False
Else
ReminderInBody = True
ProcessThisEmail = False
End If
If InStr(1, LCase(.Body), "openstaande posten") = 0 Then
ReminderInBody1 = False
Else
ReminderInBody1 = True
ProcessThisEmail = False
End If
NumIcfAttach = 0
NumPdfAttach = 0
NumXmlAttach = 0
NumDocAttach = 0
For InxA = 1 To .Attachments.Count
Select Case LCase(Right$(.Attachments(InxA).FileName, "3"))
Case "txt"
NumIcfAttach = NumIcfAttach + 1 'code will be changed soon, need to look at ICF in the name of the attachment
Case "pdf"
NumPdfAttach = NumPdfAttach + 1
Case "doc"
NumDocAttach = NumDocAttach + 1
Case "xml"
NumXmlAttach = NumXmlAttach + 1
End Select
Next InxA
Else ' Not email
ProcessThisEmail = False
End If
End With
' Decide if email is to be processed
If ProcessThisEmail = True Then
If NumXmlAttach > 1 Then
ProcessThisEmail = False
Else
If NumDocAttach <> 0 Then
ProcessThisEmail = False
Else
If NumPdfAttach > 1 Then
ProcessThisEmail = False
Else
If NumIcfAttach > 1 Then
ProcessThisEmail = False
Else
If NumIcfAttach + NumPdfAttach = 2 Then
ProcessThisEmail = True
Else
If NumXmlAttach + NumPdfAttach = 2 Then
ProcessThisEmail = True
Else
If NumXmlAttach = 1 And NumIcfAttach = 0 And NumPdfAttach = 0 And NumDocAttach = 0 Then
ProcessThisEmail = True
Else
If NumPdfAttach = 1 And NumIcfAttach = 0 And NumXmlAttach = 0 And NumDocAttach = 0 Then
ProcessThisEmail = True
Else
If NumIcfAttach = 1 And NumXmlAttach = 0 And NumPdfAttach = 0 And NumDocAttach = 0 Then
ProcessThisEmail = True
Else
If NumXmlAttach + NumPdfAttach + NumIcfAttach = 0 Then
ProcessThisEmail = False
Else
If NumXmlAttach + NumIcfAttach = 2 Then
ProcessThisEmail = False
Else
If NumXmlAttach + NumPdfAttach + NumIcfAttach = 3 Then
ProcessThisEmail = False
Else
If NumIcfAttach + NumPdfAttach <> 2 Then
ProcessThisEmail = False
Else
If NumXmlAttach + NumPdfAttach <> 2 Then
ProcessThisEmail = False
Else
Procisthisemail = False
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
' Output diagnostic information
DiagFile.WriteLine "----- " & InxItemCrnt & " -----"
With FldrInvInbox.Items.Item(InxItemCrnt)
DiagFile.WriteLine "ReceivedTime=" & .ReceivedTime
DiagFile.WriteLine "Sender=" & .Sender
Subject = .Subject
For Pos = Len(Subject) To 1 Step -1
If AscW(Mid(Subject, Pos, 1)) < 1 Or _
AscW(Mid(Subject, Pos, 1)) > 255 Then
Subject = Replace(Subject, Mid(Subject, Pos, 1), "?")
End If
Next
DiagFile.WriteLine "Subject=" & Subject
DiagFile.WriteLine "Reminders: Subject 1=" & ReminderInSubject & _
" Subject 2=" & ReminderInSubject1 & _
" Body 1=" & ReminderInBody & _
" Body 2=" & ReminderInBody1
DiagFile.WriteLine "Attachment counts: ICF=" & NumIcfAttach & _
" PDF=" & NumPdfAttach & " XML=" & NumXmlAttach & _
" Doc=" & NumDocAttach
DiagFile.WriteLine "ProcessThisEmail=" & ProcessThisEmail
End With
' Process email if required
If ProcessThisEmail Then
End If
Next InxItemCrnt
DiagFile.Close
End Sub
答案 0 :(得分：1)
我的第一个反应是：您修改后的问题中有太多未经测试的代码。我打算审查您的代码，但是大部分答案是一个教程，解释了我将如何解决您的要求。
我们都不是天生就有编写所需宏的知识。我从Excel VBA开始，我相信这是幸运的，因为Excel VBA的培训材料比Outlook VBA的培训材料好得多。我参观了一个好的图书馆，并借了几本“教自己编程Excel”的书。我尝试了所有方法，然后购买了最适合我的学习风格的方法。我建议您花几天时间学习Excel VBA。我相信这项投资将很快收回投资。我确实购买了强烈推荐的Outlook VBA，但没有留下深刻的印象。从Excel到Outlook的过渡并不像以前那样容易，因为我从未找到关于Outlook对象模型的很好的解释。我的大部分知识是多年来多年试验的结果。这种背景意味着我通常可以查看一些解释不正确的Outlook属性，并能够推断出他们要说的话。
我的优势之一是我花了一些时间研究开发和测试理论。您的代码中几乎没有错，但是我相信采用其他方法可以更快地产生预期的结果。
我向您推荐的另一个优点是系统上名为“ Resources”的文件夹，其中包含按主题划分的子文件夹。每次完成开发时，我都会遍历代码以寻找可能再次需要的想法。我将每个想法保存在相应子文件夹中的文件中，并提供示例代码，对源的引用以及我发现有困难的任何内容的注释。我使用VBA的频率不足以记住我所学的一切。在开始新开发时能够查找相关文件为我节省了很多时间。
足够的一般要点。从您最初的问题来看，我认为您需要满足以下条件：
您不清楚要选择哪些电子邮件的原始说明。添加的代码更加清晰，但增加了复杂性，使您设想对不同的电子邮件进行不同的答复。
在您的代码中，您不会向上或向下阅读invoice@rr.com的收件箱。相反，您使用Inspector处理选定的电子邮件。这样，您就可以选择没有附件的电子邮件，并测试您的代码处理方式。我认为这不是一个好主意。对我来说，阅读收件箱并选择要处理的电子邮件是更大，更复杂的代码块。我想先编写并测试该代码，然后再将其编写为回复或移动电子邮件的代码。在我知道所有其他信息正确之前，我不希望回复电子邮件。在完成测试之前，我不希望将电子邮件移至其他文件夹，因为我不想将其移回进行重新测试。
我的方法可能存在的问题是invoice@rr.com的收件箱中的电子邮件数量。如何测试每封电子邮件是否正确识别为需要回复或不需要回复？ VBA附带了一些诊断辅助工具，但是我最喜欢的技术之一是为我的代码编写信封，但输出诊断文本来标识代码所做出的决策，而无需执行这些决策。我编写的代码说明了我的意思。
要输出诊断文本，我可以使用类似Debug.Print "xxxx=" & xxxx的东西，其中xxxx是变量。这将输出到立即窗口，这通常是最方便的技术。但是您只能看到最后200个左右的显示，显示Debug.Print，我怀疑这还不够。相反，我将输出到文本文件。我这样做的频率不足以记住语法，因此我有一个文件提醒我。文件“输出到诊断文件.txt”包含：
' Needs reference to Microsoft Scripting Runtime
Dim Fso As New FileSystemObject
Dim DiagFile As TextStream
Dim PathDiag As String
PathDiag = ThisWorkbook.Path
PathDiag = CreateObject("WScript.Shell").specialfolders("Desktop")
Set DiagFile = Fso.CreateTextFile(PathDiag & "\Diag.txt", True, False)
DiagFile.WriteLine ""
DiagFile.Close
我不需要有关Outlook的“ Microsoft脚本运行时”的提醒，因为我是在首次安装Outlook时引用的。您将需要打开Outlook VBA编辑器，单击“工具”，然后从下拉菜单中选择“引用”。向下滚动库列表，然后勾选“ Microsoft Scripting Runtime”。没有此引用，编译器将无法识别“ FileSystemObject”或“ TextStream”。如果我使用Excel，则将PathDiag用作第一个值。在这里，我将使用第二个值在桌面上创建文件。
我从注释中引用的答案中提取了代码。我重命名了一些变量并简化了附件的处理。我从“输出到诊断文件.txt”文件中插入了代码。我添加了代码以提取选择电子邮件所需的值。此代码仅涉及简单的（对我而言）语句，我记得如何正确使用它们。我添加了代码以将诊断输出到文本文件。在这里我遇到了一个问题。 DiagFile.WriteLine “Subject=" & .Subject的执行停止，称这是无效的呼叫。我花了一些时间来找出原因并添加代码来解决它。我将解释后者。这是我的代码：
Option Explicit
Sub ReplyToInvoiceEmails()
Dim Fso As New FileSystemObject
Dim DiagFile As TextStream
Dim FldrInvInbox As MAPIFolder
Dim InxA As Long
Dim InxItemCrnt As Long
Dim NumIcoAttach As Long
Dim NumPdfAttach As Long
Dim NumXmlAttach As Long
Dim PathDiag As String
Dim Pos As Long
Dim ProcessThisEmail As Boolean
Dim Subject As String
Dim ReminderInBody As Boolean
Dim ReminderInSubject As Boolean
Set FldrInvInbox = Session.Folders("tonydallimore23@gmail.com").Folders("Inbox")
PathDiag = CreateObject("WScript.Shell").specialfolders("Desktop")
Set DiagFile = Fso.CreateTextFile(PathDiag & "\Diag.txt", True, False)
For InxItemCrnt = FldrInvInbox.Items.Count To 1 Step -1
With FldrInvInbox.Items.Item(InxItemCrnt)
' It is unlikely an Inbox will contain anything but emails
' but it does no harm to check
If .Class = olMail Then
' Extract information that will identify if this email is to be processed
ProcessThisEmail = True ' Assume True until find otherwise
If InStr(1, LCase(.Subject), "reminder") = 0 Then
ReminderInSubject = False
Else
ReminderInSubject = True
End If
If InStr(1, LCase(.Body), "reminder") = 0 Then
ReminderInBody = False
Else
ReminderInBody = True
End If
NumIcoAttach = 0
NumPdfAttach = 0
NumXmlAttach = 0
For InxA = 1 To .Attachments.Count
Select Case LCase(Right$(.Attachments(InxA).Filename, "3"))
Case "ico"
NumIcoAttach = NumIcoAttach + 1
Case "pdf"
NumPdfAttach = NumPdfAttach + 1
Case "xml"
NumXmlAttach = NumXmlAttach + 1
End Select
Next InxA
Else ' Not email
ProcessThisEmail = False
End If
End With
' Decide if email is to be processed
If ProcessThisEmail Then
If ReminderInSubject Or ReminderInBody Then
ProcessThisEmail = False
ElseIf NumXmlAttach = 1 Then
ProcessThisEmail = False
End If
End If
' Output diagnostic information
DiagFile.WriteLine "----- " & InxItemCrnt & " -----"
With FldrInvInbox.Items.Item(InxItemCrnt)
DiagFile.WriteLine "ReceivedTime=" & .ReceivedTime
DiagFile.WriteLine "Sender=" & .Sender
Subject = .Subject
For Pos = Len(Subject) To 1 Step -1
If AscW(Mid(Subject, Pos, 1)) < 1 Or _
AscW(Mid(Subject, Pos, 1)) > 255 Then
Subject = Replace(Subject, Mid(Subject, Pos, 1), "?")
End If
Next
DiagFile.WriteLine "Subject=" & Subject
DiagFile.WriteLine "Reminders: Subject=" & ReminderInSubject & _
" Body=" & ReminderInBody
DiagFile.WriteLine "Attachment counts: ICO=" & NumIcoAttach & _
" PDF=" & NumPdfAttach & " XML=" & NumXmlAttach
DiagFile.WriteLine "ProcessThisEmail=" & ProcessThisEmail
End With
' Process email if required
If ProcessThisEmail Then
End If
Next InxItemCrnt
DiagFile.Close
End Sub
第一个可执行语句是Set FldrInvInbox = Session.Folders("tonydallimore23@gmail.com").Folders("Inbox")。您必须将“ tonydallimore23@gmail.com”替换为“ invoice@rr.com”或该商店的真实名称。除此更改外，此代码应在您的系统上运行没有问题。
接下来是准备诊断文本文件的语句，然后是：For InxItemCrnt = FldrInvInbox.Items.Count To 1 Step -1。
FldrInvInbox.Items是一个集合，其中包含FldrInvInbox中的所有项目。集合类似于数组（如果您知道数组是什么），除了可以向集合的中间添加项目并从中间删除项目。 FldrInvInbox.Items.Count是FldrInvInbox.Items中的项目数。我正在按其位置访问此收藏集中的项目。如果代码决定将项目5移到另一个文件夹，则项目6变为项目5，项目7变为项目6，依此类推。这会搞乱前循环。我将从头开始访问此收藏集。如果我将项目1000移到另一个文件夹，那么我尚未处理的项目1至999则不要移动，以便使循环正常工作。
下一段代码将属性提取到变量中。我想我已经提取了您需要的所有属性，但您必须检查。下一个代码块确定是否要处理电子邮件。我喜欢将代码分成这样的块，因为如果需要在一年的时间内进行更改，它更容易编写和理解。我不明白您要如何选择电子邮件，我确定我的选择代码错误。您将必须更正此代码块或提供有关选择过程的更多信息，以便我可以对其进行纠正。
接下来是创建诊断输出的代码。在我的系统上，诊断输出如下：
----- 55 -----
ReceivedTime=09/08/2018 13:03:09
Sender=TechTarget Channel Media
Subject=Channel ecosystem sees major shift in partner types
Reminders: Subject=False Body=False
Attachment counts: ICO=0 PDF=0 XML=0
ProcessThisEmail=True
----- 54 -----
ReceivedTime=09/08/2018 11:48:10
Sender=TechTarget
Subject=Industrial control systems a specialised cyber target
Reminders: Subject=False Body=False
Attachment counts: ICO=0 PDF=0 XML=0
ProcessThisEmail=True
----- 53 -----
每封电子邮件的前三行标识该电子邮件，因此您可以在文件夹中找到它。后三行是我知道是错误的选择值。
如果我错过了一些选择值，则必须添加它们。您将必须更正我的选择代码。在我们继续回复代码之前，您希望每条“ ProcessThisEmail = True / False”行都是正确的。
我在诊断代码中遇到的问题是由于表情符号。该语句的执行停止了，输出了一些电子邮件的主题，我花了一些时间来查找原因。诊断文件是简单的ASCII文本文件，并且表情符号无法输出到ASCII文本文件。我想忽略这个问题，因为您不太可能在主题中使用表情符号。我决定解决此问题，因为您既没有诊断问题的经验，也没有经验来解决问题（如果确实诊断过）。查看我的代码，并尝试了解我的工作。
在进入下一部分之前，我需要您完成tmy代码。我将在稍后添加有关下一部分的一些文本，但是此部分比我所承诺的要晚得多，因此我将发布现在的内容。
接下来的几段让您考虑将要创建的电子邮件正文以及已检查“提醒”的电子邮件正文。
Outlook电子邮件可以具有三个正文：文本正文，HTML正文和RTF格式。我从未收到带有RTF正文的电子邮件。我已经看到了有关它们的问题，但是在我看来它们已经过时了。在HTML变得如此知名之前，也许它们是有用的。我将忽略RTF主体的理论存在。 Outlook电子邮件可以具有文本正文，HTML正文或两者都有。如果存在HTML主体，则该主体将显示给用户。我很少收到没有HTML正文的电子邮件。我收到的HTML正文在外观和用于创建该外观的HTML方面差异很大。许多样式表和嵌套表非常复杂，因此在笔记本电脑，智能手机或用户在其上查看过的任何设备上看起来效果都不错。我说过，Outlook电子邮件可以有一个HTML正文，而没有文本正文，但是最近几年我在档案中找不到一个。我怀疑它们是由Outlook通过HTML正文创建的，方法是删除所有HTML标记并添加回车换行符以标记已删除的段落和表格单元格。
对于Outlook电子邮件，属性Body是文本正文，属性HtmlBody是HTML正文。在我的代码中，我仅检查文本主体中的“提醒”。这似乎很明智，因为文本正文会小很多，而且如果没有文本正文，我将找不到电子邮件。如果您想保持谨慎，我将向您展示在没有文本正文的情况下如何检查HTML正文，或者您可能想将其作为培训练习来考虑。
在您的代码中，您拥有：
olReply.Body = "this is an automatic generated mail." & vbCrLf & vbCrLf & _
vbCrLf & vbCrLf & vbCrLf & ".... insert text...."
您可能会发现以下内容更具吸引力，因为如果未指定Html正文，则电子邮件软件包在显示HTML正文时往往会使用更具吸引力的字体：
olReply.Body = ""
olReply.HtmlBody = "<HTML><BODY>" & _
"<P>this is an automatic generated mail.</P>" & _
"<P>.... insert text....</P>" & _
"</BODY>" & "</HTML>"
这是非常基本的Html，现在已贬值，但它表明可以创建Html正文，而无需创建文本正文。 HTML还允许设置格式（粗体，斜体，字体大小，字体颜色等），这可能会有所帮助。