用于循环错误的VBA Outlook宏

我写了一个Outlook宏，它假设：检查收件箱中未读邮件的主题，以获取采购订单编号。如果找到采购订单编号，它会在excel文件中查找关联的电子邮件地址。（我们的卖家的电子邮件），如果它找到一个电子邮件地址，未读的电子邮件被转发到该地址，邮件标记为已读。用于循环错误的VBA Outlook宏

代码首次在主题中遇到带有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("[email protected]").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

来源

2013-07-04 Rookie

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

来源

2013-07-05 22:03:58 Rookie

用于循环错误的VBA Outlook宏

回答

相关问题