0

私は次のことを想定している Outlook マクロを作成しました。PO 番号が見つかった場合は、関連付けられている電子メール アドレスを Excel ファイルで探します。（弊社出品者メールアドレス）、メールアドレスが見つかれば、未読メールをそのアドレスに転送し、メールを既読にします。

このコードは、件名に PO 番号が含まれる未読の電子メール アドレスを初めて検出したときに正常に機能します。問題は、コードが for ループを続行しないことです。代わりに、「要素が移動または削除されました」というエラー メッセージが表示されます。問題は、すべての基準を満たすメールに最初に遭遇した後、for ループが本来あるべき方法で続行されないことだと私は 99% 確信しています。念のため、コード全体を投稿します。いつものように、私の問題をいつでもご覧いただけます。

Sub ForwardMail()

On Error GoTo eh:

'Initalizing Excel related variables and instances'
Dim xlApp As Object
Dim XlBook As Excel.Workbook

Set xlApp = CreateObject("Excel.Application")
xlApp.Application.Visible = True
Set XlBook = xlApp.Workbooks.Open("My path")

Dim Mailadress As Variant
Dim PoSheet As Excel.Worksheet
Set PoSheet = XlBook.Sheets("SheetName")
'End  Initalizing Excel related variables and instances

'Initalizing Outlook related variables and instances
Dim ns As Outlook.NameSpace
Dim folder As MAPIFolder
Dim item As Object
Dim MailToForward As MailItem

Set ns = Session.Application.GetNamespace("MAPI")
Set folder = ns.Folders("Example@mail.com").Folders("Inbox")
'Slutt initialisering Outlook relatert

Dim PoNumber As Double

'Loop through the items in the inbox folder
For Each item In folder.Items
    DoEvents
    If (item.Class = olMail) And (item.UnRead) Then
        'Find PO number from the subject
        PoNumber = CDbl(FinnPo(item.Subject))

        'If Po number is found, find email adress, using PO number
        If PoNumber <> 0 Then

            'Find email adress in excel file
            Mailadress = xlApp.VLookup(PoNumber, PoSheet.Range("C:D"), 2, False)

            'If mailadress variable is not an error, forward unread email to mailadress.
            If IsError(Mailadress) = False Then
                Set MailToForward = item.Forward
                MailToForward.To = Mailadress
                MailToForward.Send

                'Set mail property as read
                MailToForward.UnRead = False

            Else

            End If

        End If

    End If

Next

XlBook.Close
xlApp.Quit

MsgBox "Macro finished"

Exit Sub

eh:
    MsgBox Err.Description, vbCritical, Err.Number

End Sub

Function FinnPo(Subject As String) As String

    Dim find As String
    Find = "4500"

    Dim Location As Integer
    Location = InStr(Subject, Find)

    If Location <> 0 Then
        FinnPo = Mid(Subject, Location, 10)
    Else
        FinnPo = "0"
    End If

End Function
4

1 に答える 1