私は次のことを想定している 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