Outlook VBA将单个电子邮件移动到多个文件夹

我想将电子邮件从一个现有文件夹移动到一个或多个子文件夹

简单的例子：一封来自JohnDoe的电子邮件。将其移动到名为Doe，John（可能不存在）文件夹下的MMYY子文件夹（可能不存在）。如果电子邮件标记为高重要性，请将电子邮件副本放在名为“高重要性”的第二个子文件夹中。最后，如果该电子邮件在SQL查询中被标识为HighVolumeMailer，请移动到名为“HighVolumeMailer”的第三个子文件夹

VBA将电子邮件移动到MMYY文件夹，但它可能会将同一电子邮件的副本保存到其他两个文件夹。一共三个

以下是我的代码，它不起作用：

Set objDestFolder = objSourceFolder.folders(sSenderName)

If objDestFolder Is Nothing Then
    Set objDestFolder = objSourceFolder.folders.Add(sSenderName)
End If

Set objNewFolder = objDestFolder.folders(sMonthandYearOfEMail)

If objNewFolder Is Nothing Then
    Set objNewFolder = objDestFolder.folders.Add(sMonthandYearOfEMail)
End If

objVariant.Move objNewFolder
'count the # of items moved
lngMovedItems = lngMovedItems + 1

'''''if marked high importance put copy in high importance folder
If sEMailImportance = "High" Then

    '''''Set myCopiedItem = objVariant.Copy

    ''''Set objDestFolder = objSourceFolder.folders(sSenderName)

    Set objHighImportanceFolder = objNamespace.folders(sSenderName).folders(sMonthandYearOfEMail).folders("MarkedHighImportance")

    '''''Set objHighImportanceFolder = objDestFolder.folders("MarkedHighImportance")

    If objHighImportanceFolder Is Nothing Then
        Set objHighImportanceFolder = objNamespace.folders(sSenderName).folders(sMonthandYearOfEMail).Add(sMarkedHighImportance)
    End If

    objVariant.UnRead = True
    Set copy = objVariant.copy
    copy.Move.objHighImportanceFolder
    objVariant.UnRead = True

End If

''''''Now going to look for high volume calls
sEMailSubject = objVariant.Subject

blnHighVMVolume = False
LookingForThisTelephoneNumberInHighVolume = Mid(sEMailSubject, 24, 10)
g = 0

For g = LBound(vArray, 2) To UBound(vArray, 2)

    'This is where the code will determine if the telephone number is in
    'the high call volume population

    If vArray(0, g) = LookingForThisTelephoneNumberInHighVolume Then

        blnHighVMVolume = True
        NumberOfHighVolumeVMs = vArray(1, g)

    End If

Next g

If blnHighVMVolume = True Then
    ''''''Set myCopiedItem = objVariant.Copy
    Set objHighVolumeFolder = objNamespace.folders(sSenderName).folders(sMonthandYearOfEMail).folders(sHighVolumeCaller)

    If objHighVolumeFolder Is Nothing Then
        Set objHighVolumeFolder = objNamespace.folders(sSenderName).folders(sMonthandYearOfEMail).Add(sHighVolumeCaller)
    End If

    objVariant.UnRead = True
    Set copy = objVariant.copy
    copy.Move.objHighVolumeFolder
    objVariant.UnRead = True

End If

VBA将电子邮件移动到MMYY文件夹，但它可能会将同一电子邮件的副本保存到其他两个文件夹。一共三个

似乎您需要使用Outlook项目的方法制作三个副本，然后将它们复制到这些文件夹中。例如：

Set myCopiedItem = myItem.Copy  
myCopiedItem.Move myNewFolder 

无论如何，在您的代码中，我注意到以下几行：

 Set copy = objVariant.copy
 copy.Move.objHighImportanceFolder

看起来需要更正第二行代码：objHighImportanceFolder不是属性或方法，而是传递给函数的参数。应该是这样的：

 Set copy = objVariant.copy
 copy.Move objHighImportanceFolder

---

哪行代码不起作用？运行代码时会发生什么情况？无论其他什么可能出错，请将Set copy=objVariant.copy替换为Set objcopy=objVariant.copy。非常感谢！！！！！这修复了移动复制问题，但我在尝试设置子文件夹时仍有问题。您或其他人能告诉我如何设置将电子邮件移动到的文件夹吗？我需要将电子邮件移动到名为HighImportanceEmails的文件夹中。此HighImportanceEmails子文件夹位于一系列其他文件夹下。这是文件夹结构-Set-objDestFolder=objSourceFolder.folders（sUnderName）Set-objHighImportanceFolder=objDestFolder.folders（SmonthandYearOfMail.folders）（“MarkedHighImportance”）提前谢谢！！！你解释了如何移动/复制，但这只是我的问题的一半。我正在试图找出如何设置要将副本移动到的子文件夹。我不知道如何设置子文件夹。如何编写代码以将副本保存到位于此处的文件夹中-sSenderName/MMYY/highimportantionfolder。我可以使用现有代码将电子邮件移动到SenderName/MMYY，但无法将电子邮件副本移动到第三个文件夹。你能解释一下如何将文件夹设置为第三个文件夹吗？