gpt4 book ai didi

excel - 在循环中键入不匹配以扫描 Outlook 邮件

转载 作者:行者123 更新时间:2023-12-02 07:32:26 26 4
gpt4 key购买 nike

使用 VBA 循环浏览 Outlook 收件箱时出现间歇性错误。 Next objOutlookMes​​g 行发生类型不匹配。

注意:我想尽可能完整,所以我包含了所有代码。滚动到底部查看错误发生位置的简短片段。

Private Sub CheckInbox(strFolder As String, Title As String)

Dim objOutlook As Outlook.Application
Dim objOutlookNS As Outlook.Namespace
Dim objOutlookInbox As Outlook.Folder
Dim objOutlookComp As Outlook.Folder
Dim objOutlookMesg As Outlook.MailItem
Dim Headers(1 To 20) As String
Dim i As Integer

Headers(1) = "Division:"
Headers(2) = "Request:"
Headers(3) = "Exception Type:"
Headers(4) = "Owning Branch:"
Headers(5) = "CRM Opportunity#:"
Headers(6) = "Account Type:"
Headers(7) = "Created Date:"
Headers(8) = "Close Date:"
Headers(9) = "Created By:"
Headers(10) = "Account Number:"
Headers(11) = "Revenue Amount:"
Headers(12) = "Total Deposit Reported:"
Headers(13) = "Actual Total Deposits Received:"
Headers(14) = "Deposit Date:"
Headers(15) = "Deposit Source:"
Headers(16) = "Explanation:"
Headers(17) = "Shared Credit Branch:"
Headers(18) = "Shared Credit: Amount to Transfer:"
Headers(19) = "OptionsFirst: Deposit Date:"
Headers(20) = "OptionsFirst: Total Deposit:"

Set objOutlook = Outlook.Application
Set objOutlookNS = objOutlook.GetNamespace("MAPI")
Set objOutlookInbox = objOutlookNS.GetDefaultFolder(olFolderInbox)
Set objOutlookComp = objOutlookInbox.Folders(strFolder)

For Each objOutlookMesg In objOutlookInbox.Items
objOutlookMesg.Display
If Trim(objOutlookMesg.Subject) Like Title Then
For i = 1 To 20
WriteToExcel i, EmailTextExtraction(Headers(i), objOutlookMesg), 1
Next i
objOutlookMesg.Move objOutlookComp
End If
Next objOutlookMesg

End Sub

Private Sub WriteToExcel(CollumnNDX As Integer, Data As String, WorksheetNDX As Integer)
'Writes data to first empty cell on the specified collumn in the specified workbook

Dim RowNDX As Long

Do
RowNDX = RowNDX + 1
Loop Until Worksheets(WorksheetNDX).Cells(RowNDX, CollumnNDX) = Empty

Worksheets(WorksheetNDX).Cells(RowNDX, CollumnNDX).Value = Data

End Sub

Private Function EmailTextExtraction(Field As String, Message As Outlook.MailItem) As String
'Obtains the data in a field of a text formatted email when the data
'in that field immediately follows the field and is immediately followed
'by a carriage return.

Dim Position1 As Long
Dim Position2 As Long
Dim Data As String
Dim FieldLength As Integer

FieldLength = Len(Field)
Position1 = InStr(1, Message.Body, Field, vbTextCompare) + FieldLength
Position2 = InStr(Position1, Message.Body, Chr(10), vbTextCompare)
'may need to use CHAR(13) depending on the carriage return
Data = Trim(Mid(Message.Body, Position1, Position2 - Position1))

EmailTextExtraction = Data

End Function

发生错误的代码的较短片段:

For Each objOutlookMesg In objOutlookInbox.Items
objOutlookMesg.Display
If Trim(objOutlookMesg.Subject) Like Title Then
For i = 1 To 20
WriteToExcel i, EmailTextExtraction(Headers(i), objOutlookMesg), 1
Next i
objOutlookMesg.Move objOutlookComp
End If
Next objOutlookMesg <<<< intermitent type mismatch error here

我认为该错误可能与邮件项目的类别有关。现在正在寻找过滤器。

最佳答案

Outlook 文件夹具有默认对象类型(MailItem、AppointmentItem、ContactItem 等),但实际上可以保存任何项目类型。因此,您遇到的项目不是 MailItem,并且凭借 For Each 循环,尝试将其分配给 MailItem 类型的变量。

您需要循环遍历通用对象并测试 TypeName。

Dim oItem As Object
Dim oMail As MailItem

For Each oItem In Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items
If TypeName(oItem) = "MailItem" Then
Set oMail = oItem

'do stuff with omail
End If
Next oItem

关于excel - 在循环中键入不匹配以扫描 Outlook 邮件,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/18701705/

26 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com