Question

我有以下Visual Basic脚本，应该将我的收件箱中的电子邮件移动到特定文件夹，但是当我运行它时，没有任何反应。我对VBA很新，所以对于为什么会有点困惑。有什么突出的，或者你有什么建议，如何找出这是（'nt）发生的原因？谢谢！

代码：

Sub Move_Emails()
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(6)
Set myItems = myInbox.Items
Dim myItem As Outlook.MailItem
Dim MailItem As Object
Dim sn As String

For Each MailItem In myInbox.Items
    sn = MailItem.SenderName
    If sn = "John Doe" Then
        Set myDestFolder = myInbox.Folders("Folder1")
    ElseIf sn = "Jane Smith" Then
        Set myDestFolder = myInbox.Folders("Folder2")
    ElseIf sn = "Bob Jones" Then
        Set myDestFolder = myInbox.Folders("Folder3")
    End If
    Set myItem = myItems.Find("[SenderName] = sn")
    While TypeName(myItem) <> "Nothing"
        myItem.Move myDestFolder
        Set myItem = myItems.FindNext

    Wend
Next
End Sub

Answer 1

您需要更改myItem variable的设置方式。在您的代码中sn是一个变量，如果您将其放在引号内，则不会将其转换为真实的发件人名称。所以，而不是这一行：

Set myItem = myItems.Find("[SenderName] = sn")

使用这一行：

Set myItem = myItems.Find("[SenderName]='" & sn & "'")

根据以下评论

编辑关于可能出现的问题...当您以这种方式检查名称时：

If sn = "John Doe" Then

您检查John Doe的确切名称，包括大/小的情况。我建议用这种方式改变它：

If Ucase(sn) = "JOHN DOE" Then

以避免名称拼写可能出现问题。对If statement中的所有检查执行此操作。

编辑第二个 ...我刚刚意识到您使用了错误的循环来移动元素。如果您将一个元素移动到其他文件夹，则在使用For each loop时更改循环的顺序。因此，我建议在新的完整代码中进行更多更改：

Sub Move_Emails_improved()
Dim myNamespace, myInbox, myItems ', myDestFolder- NEW CHANGED MOVED TO SEPARATE LINE BELOW
Set myNamespace = Application.GetNamespace("MAPI")
Set myInbox = myNamespace.GetDefaultFolder(6)   
Set myItems = myInbox.items
Dim myItem As Outlook.MailItem
Dim MailItem As Object
Dim sn As String

'NEW LINE BELOW
Dim myDestFolder As Folder
'here you need different kind of loop
Dim i as integer
For i = myInbox.items.Count To 1 Step -1   'loop goes from last to first element
    sn = myInbox.items(i).SenderName

    'first possible problem
    If Ucase(sn) = "JOHN DOE" Then
        Set myDestFolder = myInbox.folders("Folder1")

    'alternatively you could check name in this way
    ElseIf UCase(sn) Like "*JANE SMITH*" Then
        Set myDestFolder = myInbox.folders("Folder2")
    ElseIf sn = "Bob Jones" Then
        Set myDestFolder = myInbox.folders("Folder3")
    End If
    Set myItem = myItems.Find("[SenderName]='" & sn & "'")

    'here we need to check if folder is not set
    'NEW- THIS LINE IMPROVED
    While TypeName(myItem) <> "Nothing" And And Not myDestFolder Is Nothing
        myItem.Move myDestFolder
        Set myItem = myItems.FindNext
        'NEW LINE BELOW
        i = i - 1

    Wend
    'and set destination folder to nothing to eliminate all problems
    Set myDestFolder = Nothing
Next
End Sub

希望它现在可以运作。

Answer 2

您也可以使用：

If myitem.Sender Like "*" & sn & "*" Then
    ' your code

根据SenderName将电子邮件移动到文件夹

2 个答案: