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

Question

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

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

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

Answer 1

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

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

Set myCopiedItem = myItem.Copy  
myCopiedItem.Move myNewFolder 

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

 Set copy = objVariant.copy
 copy.Move.objHighImportanceFolder

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

 Set copy = objVariant.copy
 copy.Move objHighImportanceFolder