我有一个代码，可以自动将PDF从收到的消息移到我选择的文件夹，但是实际上，我真正需要的是能够根据发件人将文件移到特定的文件夹。
下面的代码仅适用于一个发件人，如何添加更多发件人和更多文件夹位置？
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
'Only act if it's a MailItem
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item
'Change variables to match need. Comment or delete any part unnecessary.
If (Msg.SenderName = "Marc, Test") And _
(Msg.Subject = "Heures") And _
(Msg.Attachments.Count >= 1) Then
'Set folder to save in.
Dim olDestFldr As Outlook.MAPIFolder
Dim myAttachments As Outlook.Attachments
Dim Att As String
'location to save in. Can be root drive or mapped network drive.
Const attPath As String = "C:\Users\NAEC02\Test\"
' save attachment
Set myAttachments = item.Attachments
Att = myAttachments.item(1).DisplayName
myAttachments.item(1).SaveAsFile attPath & Att
' mark as read
Msg.UnRead = False
End If
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
在回答您的问题之前，请对您现有的代码进行一些注释。
您正在Outlook中运行此代码。您不需要olApp。如果您试图从Excel或其他Office产品访问电子邮件，则仅需要对Outlook应用程序的引用。
令我惊讶的是我经常看到On Error GoTo ErrorHandler，因为我从未从此语句中找到用处。
如果我为自己编码，我希望在导致问题的语句上停止执行，这样我就可以理解正在发生的事情而不必从错误消息中猜测出来。如果在导致错误的语句上执行停止，并且可以立即修复错误，则可以重新启动代码。
如果我是为客户开发的，那么最糟糕的是，我希望获得一条用户友好的消息。 Err.Number & " - " & Err.Description不是我对用户友好消息的想法。它甚至没有告诉我是哪个电子邮件引起了问题。对于客户，我会有类似的东西：
Dim ErrDesc as String
Dim ErrNum as Long
: : :
On Error Resume Next
Statement that might give an error
ErrNum = Err.Num
ErrDesc = Err.Description
On Error GoTo 0
If ErrNum <> 0 Then
Code to handle errors that can occur with
this statement in a user-friendly manner.
End If
今天Dim Att As String很好，因为您记得Att是什么。您会记得在六个或十二个月内更新此宏吗？更新此宏的同事是否知道Att是什么？我将其命名为AttName或AttDsplName。
您说代码保存了PDF附件，但您没有对此进行检查。对于VBA宏，徽标，图像，签名和其他文件也是附件。同样，您假设您要保存的附件为Attachments(1)。如果有多个附件，则徽标，图像和签名可以优先出现。
您有：
'Set folder to save in.
Dim olDestFldr As Outlook.MAPIFolder
您未设置olDestFldr，也没有将电子邮件移动到其他文件夹。您要这样做吗？
现在您的问题。我提供了实现目标的两种方法的代码，并讨论了另外两种方法。但是，在向您展示代码之前，我怀疑需要向您介绍Variants。考虑：
Dim A As Long
Dim B As String
Dim C As Double
Dim D As Variant
我已声明A到C为长整数，字符串和双精度数。这些变量永远不能是其他任何变量，必须根据其类型规则使用。我可以写A = A + 1或A = A * 5。如果为A提供新值不超过长整数的最大值，那么这些语句就可以了。但是我不能写A = "House"，因为“ House”不是整数。我可以写B = "House"，因为“ House”是一个字符串。我可以先写B = "5"，然后写A = A + B，因为VBA会执行隐式转换。也就是说，VBA可以将字符串“ 5”转换为整数5并将其添加到A。
我也可以写：
D = 5
D = D + A
D = "House"
D是变量，表示它可以保存任何类型的数据。在这里，我为D分配5，然后加上A，因此对于这两个语句，D保留一个整数。然后，我改变主意并将字符串分配给D。这不是很明智的代码，但是它是有效的代码。 D可以容纳的不止是整数和字符串。特别是，它可以容纳一个数组。考虑：
ReDim D(0 To 2)
D(0) = "House"
D(1) = A + 5
D(2) = 3.7
在ReDim语句之后，好像D已被转换为数组，并且我使用数组语法来访问D的元素。D(0)包含“ House”，D(1)包含比当前值多5个值A和D(2)中包含3.7的两倍。
我可以通过以下方式获得相同的效果：
D = Array("House", A + 5, 3.7)
我确信您同意这会更容易。 Array是一个函数，可以接受大量参数，并返回包含我分配给D的那些参数的Variant数组。我通常不建议在变量数组中混合类型，因为很容易陷入混乱。但是，它是有效的VBA，我发现它在遇到特别困难的问题时具有无价的价值。通常，我不会使用函数Array，而是会写：
D = VBA.Array("House", A + 5, 3.7)
使用VBA.Array，保证数组的下限为零。对于Array，下限取决于Option Base语句。我从未见过有人使用Option Base语句，但是我不喜欢冒险有人添加此语句来更改我的代码。搜索“ VBA Option Base语句”以发现该语句的作用。
以下代码演示了我实现目标的第一种方法：
Option Explicit
Sub Method1()
Dim DiscFldrCrnt As Variant
Dim DiscFldrs As Variant
Dim Inx As Long
Dim SenderNameCrnt As Variant
Dim SenderNames As Variant
Dim SubjectCrnt As Variant
Dim Subjects As Variant
SenderNames = VBA.Array("Doe, John", "Early, Jane", "Friday, Mary")
Subjects = VBA.Array("John's topic", "Jane's topic", "Mary's topic")
DiscFldrs = VBA.Array("DoeJohn", "EarlyJane", "FridayMary")
For Inx = 0 To UBound(SenderNames)
SenderNameCrnt = SenderNames(Inx)
SubjectCrnt = Subjects(Inx)
DiscFldrCrnt = DiscFldrs(Inx)
' Code to process SenderNameCrnt, SubjectCrnt and DiscFldrCrnt
Debug.Print SenderNameCrnt & " " & SubjectCrnt & " " & DiscFldrCrnt
Next
End Sub
如果将此代码复制到模块，则可以运行它并查看其作用。如果您通过它缓慢地进行工作，那么您应该能够了解它在做什么。如有必要，请再提问，但您自己发现的内容越多，您就能更快地发展自己的技能。
注：光盘文件夹的名称如“ DoeJohn”。我假设您将“ C：\ Users \ NAEC02 \ Test \”作为根文件夹，并将附件保存到“ C：\ Users \ NAEC02 \ Test \ DoeJohn \”。
当我需要链接的值很少时，使用此方法。它依赖于SenderNames(#)，Subjects(#)和DiscFldrs(#)被关联。随着不同组合数量的增加，可能很难使三个阵列保持一致。 Method2解决了这个问题。
Sub Method2()
Dim DiscFldrCrnt As Variant
Dim Inx As Long
Dim SenderNameCrnt As Variant
Dim SubjectCrnt As Variant
Dim TestValues As Variant
TestValues = Array("Doe, John", "John's topic", "John", _
"Early, Jane", "Jane's topic", "Jane", _
"Friday, Mary", "Mary's topic", "Mary")
For Inx = LBound(TestValues) To UBound(TestValues) Step 3
SenderNameCrnt = TestValues(Inx)
SubjectCrnt = TestValues(Inx + 1)
DiscFldrCrnt = TestValues(Inx + 2)
' Code to process SenderNameCrnt, SubjectCrnt and DiscFldrCrnt
Debug.Print SenderNameCrnt & " " & SubjectCrnt & " " & DiscFldrCrnt
Next
End Sub
这里我将所有值都放在一个数组中。如果要添加新的发件人，则在数组的末尾添加另外三个元素，我认为这更易于管理。对于要处理这三个值的代码，Method1和Method2相同。
Method2与Method1相比的主要缺点是减少了值的总数。我喜欢看所有代码，所以我不喜欢超出屏幕宽度的语句。这将我的行数限制为大约100个字符。我使用延续字符将语句分散在多行中，但是每个语句最多有24条连续行。使用Method1，我将值分布在三个数组上，因此将三个语句分散开来，因此我可以拥有三倍的值。实际上，这不是真正的限制。在达到VBA限制之前，Method1和Method2都变得难以管理。
Method1和Method2的真正缺点是，每次更改都需要程序员的服务。如果用户维护很重要，则可以使用Method3将文本文件读取到数组中，或者使用Method4从Excel工作表中读取。我没有包括Method3或Method4的代码，但是如果需要此功能，可以添加一个或两个。我发现大多数用户都喜欢工作表，但那些拥有喜欢的文本编辑器的人更喜欢文本文件。
在Method1和Method2的中间，我有：
' Code to process SenderNameCrnt, SubjectCrnt and DiscFldrCrnt
Debug.Print SenderNameCrnt & " " & SubjectCrnt & " " & DiscFldrCrnt
您需要用现有代码的变体替换这些语句。我没有测试以下代码的简便方法，因此未经测试，但是应该可以开始使用。
这是Items_ItemAdd的新版本，旨在与我的任何一种方法一起使用。
Private Sub Items_ItemAdd(ByVal Item As Object)
Const DiscFldrRoot As String = "C:\Users\NAEC02\Test\"
' * There is no need to write Outlook.MailItem because (1) you are within Outlook
' and (2) there is no other type of MailItem. You only need to specify Outlook
' for folders since there are both Outlook and Scripting folders. Note:
' "Scripting" is the name of the library containing routines for disc folders.
' * Do not spread your Dim statements throughout your sub. There are languages
' where you can declare variables within code blocks but VBA is not one of those
' languages. With VBA, you can declare variables for an entire sub or function,
' for an entire module or for an entire workbook. If you spread your Dim
' statements out it just makes them hard to find and you are still declaring
' them at the module level.
Dim DiscFldrCrnt As Variant
Dim InxA As Long
Dim Msg As MailItem
Dim SenderNameCrnt As Variant
Dim SubjectCrnt As Variant
' You also need the arrays from whichever of Method1 or Method2 you have chosen
If TypeName(item) = "MailItem" Then
' Only interested in MailItems
Set Msg = Item
' Code from Method1 or Method2 with the code below in the middle
End If
End Sub
在以上代码的中间插入Method1或Method2的主体，无论您选择哪个。然后在该代码的中间插入以下代码。
With Msg
If .Attachments.Count = 0 Then
' Don't bother to check MailItem if there are no attachments
Else
If .Subject <> SubjectCrnt Then
' Wrong subject so ignore this MailItem
ElseIf .SenderName <> SenderNameCrnt Then
' Wrong sender name so ignore this MailItem
Else
' SenderName and Subject match so save any PDF attachments
For InxA = 1 to .Attachments.Count
If LCase(Right$(.Attachments(InxA).DisplayName, 4)) = ".pdf" Then
' Warning: SaveAsFile overwrites existing file with the same name
.Attachments(InxA).SaveAsFile DiscFldrRoot & DiscFldrCrnt & _
.Attachments(InxA).DisplayName
End If
End With
Next
End If
End With