PDA

View Full Version : Reading Undelivered mails from outlook.code problem



usmanusman2
05-07-2008, 11:31 PM
have to read undelivered e-mail messages from outlook inbox and store in a text file. i am total newbie in VBA. so plz help.
Here is my code.

Public Sub ProcessInbox()
Dim oOutlook As Outlook.Application
Dim oNs As Outlook.NameSpace
Dim oFldr As Outlook.MAPIFolder
Dim iMsgCount As Integer
Dim oMessage As Outlook.ReportItem
Dim iCtr As Long, iAttachCnt As Long

Set oOutlook = New Outlook.Application
Set oNs = oOutlook.GetNamespace("MAPI")
Set oFldr = oNs.GetDefaultFolder(olFolderInbox)
For Each oMessage In oFldr.Items

With oMessage
'basic info about message
If (oMessage.Subject) = "Undeliverable" Then
Debug.Print .To
Debug.Print .CC
Debug.Print .Subject
Debug.Print .Body
iMsgCount = iMsgCount + 1
'save message as text file
.SaveAs "C:\message" & iMsgCount & ".txt", olTXT
end if
End With
DoEvents

Next oMessage


Set oAttachment = Nothing
Set oAttachments = Nothing
Set oMessage = Nothing
Set oFldr = Nothing
Set oNs = Nothing
Set oOutlook = Nothing

End Sub

At this line
For Each oMessage In oFldr.Items
i am getting error run-time error 13 type mismatch

Oorang
05-09-2008, 10:57 PM
Option Explicit

Public Sub ProcessInbox()
Const ForWriting As Long = 2
Const TristateUseDefault As Long = -2
Dim oOutlook As Outlook.Application
Dim oNs As Outlook.Namespace
Dim oFldr As Outlook.MAPIFolder
Dim iMsgCount As Integer
Dim oMessage As Outlook.ReportItem
Dim iCtr As Long, iAttachCnt As Long
Dim fso As Object
Dim ts As Object
Set oOutlook = New Outlook.Application
Set oNs = oOutlook.GetNamespace("MAPI")
Set oFldr = oNs.GetDefaultFolder(olFolderInbox)
Set fso = CreateObject("Scripting.Runtime")
Set ts = fso.OpenTextFile("C:\Output.txt", ForWriting, True, TristateUseDefault)
For Each oMessage In oFldr.Items

With oMessage
'basic info about message
If (oMessage.Subject) = "Undeliverable" Then

ts.WriteLine .To
ts.WriteLine .CC
ts.WriteLine .Subject
ts.WriteLine .Body & vbNewLine & vbNewLine
iMsgCount = iMsgCount + 1
'save message as text file
.SaveAs "C:\message" & iMsgCount & ".txt", olTXT
End If
End With
DoEvents

Next oMessage

ts.Close
Set oAttachment = Nothing
Set oAttachments = Nothing
Set oMessage = Nothing
Set oFldr = Nothing
Set oNs = Nothing
Set oOutlook = Nothing
Set ts = Nothing
Set fso = Nothing
End Sub