0

受信トレイ内の電子メールを特定のフォルダーに移動する次の Visual Basic スクリプトがありますが、実行しても何も起こりません。私はVBAに非常に慣れていないので、その理由について少し混乱しています。何か目立っていることはありますか、またはこれが起こっている理由を見つける方法について何か提案はありますか? ありがとう！

コード：

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
4

2 に答える 2

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。

2番目に編集...要素を移動するために間違ったループを使用していることに気付きました。その結果、1 つの要素を他のフォルダーに移動すると、使用時にループの順序が変更されます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

今すぐうまくいくことを願っています。

于 2013-07-01T19:57:45.007 に答える
-1

これも使用できます：

If myitem.Sender Like "*" & sn & "*" Then
    ' your code
于 2015-02-03T17:16:54.077 に答える