VBA Outlook宏for循环错误

时间:2013-07-04 15:35:09

标签: for-loop outlook-vba

我编写了一个Outlook宏,其假设是:检查收件箱中未读电子邮件的主题,以获取采购订单编号。如果找到采购订单编号,则会在Excel文件中查找关联的电子邮件地址。 (我们卖家的电子邮件),如果找到电子邮件地址,则未读电子邮件将转发到该地址,并将邮件标记为已读。

代码在第一次遇到主题中包含PO编号的未读电子邮件地址时工作正常。问题是代码不会继续使用for循环。相反,我收到一条错误消息,说“元素已被移动或删除”。我99%肯定问题是for循环在第一次遇到满足所有标准的邮件后不会继续应该的方式。尽管如此,我还是会发布整个代码。一如往常,任何时候看着我的问题都非常感激!

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

1 个答案:

答案 0 :(得分:0)

所以很多googeling终于解决了我的代码问题。我发送邮件项MailToForward的事实意味着该项目已停止存在。因此,我必须将变量的初始化移动到循环中。我还必须在发送后标记item.Unread,而不是那时已经不存在的MailItem。希望能帮助其他有类似问题的人:MailItems在发送后停止存在。