Outlook VBA help

[boxboy30]

Could someone help me create a code in Outlook that would parse certain information from my email and then input it into an exsisting excel spreadsheet?

 

[Trevor G]

Hey well done BoxBoy that works nicely here.

Pete what security levels have you got on in your Outlook?

 

[NewOrderFac33]

OK, chaps - to confirm: I am running the code from Outlook in which the security setting is "Low".
NOW, I'm getting "Compile error: user-defined type not defined" against line: Dim appExcel As Excel.Application.
You familiar with Morrissey or The Smiths in your part of the world?

 

[Trevor G]

Yep familiar with both.

Try this out.

Sub ExportToExcel()
Dim msg As Outlook.MailItem
Dim nms As Outlook.NameSpace
Dim fld As Outlook.MAPIFolder
Dim itm As Object
Dim appExcel As Object
Dim sRow As Integer
Set appExcel = GetObject(, "Excel.Application")
Set nms = Application.GetNamespace("MAPI")
Set fld = nms.PickFolder
If fld Is Nothing Then
MsgBox "There are no mail messages to export", vbOKOnly, "Error"
Exit Sub
ElseIf fld.DefaultItemType <> olMailItem Then
MsgBox "There are no mail messages to export", vbOKOnly, "Error"
Exit Sub
ElseIf fld.Items.Count = 0 Then
MsgBox "There are no mail messages to export", vbOKOnly, "Error"
Exit Sub
End If

appExcel.Workbooks.Add
Set wkb = appExcel.ActiveWorkbook
Set wks = wkb.Sheets(1)
wks.Activate
appExcel.Application.Visible = True
appExcel.Application.DisplayAlerts = False

'On Error Resume Next
For Each itm In fld.Items
sRow = sRow + 1
appExcel.Range("A" & sRow).Value = itm.SentOn
appExcel.Range("B" & sRow).Value = itm.SenderEmailAddress
appExcel.Range("C" & sRow).Value = itm.Subject
appExcel.Range("D" & sRow).Value = itm.Body
'appExcel.Range("D" & sRow).Replace What:="" & Chr(10) & "", Replacement:=" ", LookAt:=xlPart, _
'SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
'ReplaceFormat:=False
'appExcel.Range("D" & sRow).Replace What:="" & Chr(13) & "", Replacement:=" ", LookAt:=xlPart, _
'SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
'ReplaceFormat:=False
appExcel.Range("F" & sRow).Value = itm.SentOn
appExcel.Range("G" & sRow).Value = itm.ReceivedTime
Next itm
appExcel.Application.DisplayAlerts = True
Set appExcel = Nothing
Set wkb = Nothing
Set wks = Nothing
Set msg = Nothing
Set nms = Nothing
Set fld = Nothing
Set itm = Nothing
End Sub

 

[NewOrderFac33]

Trevor,

The reason I ask is that if either of them didn't write a song called "Take me out and shoot me, Mother", I have the lyrics right here.

I'm going to restart the PC now, because both versions of the code 9the one that runs from Excel and this one) seem to be running up toa point and doint what they're supposed to, then they hang up at some arbitrary point having output a certain number of rows to the spreadsheet.
I've had this sort of thing before with the latest Excel project I'm working on and despite "switch off and switch on again" being an urban myth, it actually does seem to work in these circumstances.
I'll see ypu in a minute...

 

[NewOrderFac33]

3-2-1 you're back in the room.

OK - after a reboot, the Outlook code appears to work, exporting a number of attributes for each email message to the Excel spreadsheet.
No error messages are displayed, but having exported 69 rows of data, I just see the normal Excel cursor, as though the procedure has completed.
When i go into the VBA editor, the following message is displayed:
"Runtime error 438:Object doesbn't support this property or method", with
appExcel.Range("A" & sRow).Value = itm.SentOn
highlighted.
I would obviously like to get to the bottom of this as it will be of use in the future, but eventually, what I also need is the means to highlight or open just one message and extract the details for that and that alone.
Your continued help is greatly appreciated!

Pete

 

[NewOrderFac33]

...and going back to the Excel based code which currently looks like this:

Sub ListAllItemsInInbox()
'You have to Add the reference to Outlook
'Select Tools > References > Search for Microsoft Outlook XX.Object Library
Dim OLF As Outlook.MAPIFolder, CurrUser As String
Dim EmailItemCount As Integer, i As Integer, EmailCount As Integer
Application.ScreenUpdating = False
Sheets.Add ' Create a new workbook
'Add headings
Cells(1, 1).Formula = "Subject"
Cells(1, 2).Formula = "Received"
Cells(1, 3).Formula = "Attachments"
Cells(1, 4).Formula = "Read"
Cells(1, 5).Formula = "Sender"
With Range("A1:E1").Font
.Bold = True
.Size = 14
End With
Application.Calculation = xlCalculationManual

Set OLF = GetObject("", "Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)

EmailItemCount = OLF.Items.Count
i = 0: EmailCount = 0

' read e-mail information
While i < EmailItemCount
i = i + 1
If i Mod 50 = 0 Then Application.StatusBar = "Reading e-mail messages " & Format(i / EmailItemCount, "0%") & "..."
With OLF.Items(i)
EmailCount = EmailCount + 1
Cells(EmailCount + 1, 1).Formula = .Subject
Cells(EmailCount + 1, 2).Formula = Format(.ReceivedTime, "ddd dd mmm yy hh:mm")
Cells(EmailCount + 1, 3).Formula = .Attachments.Count
Cells(EmailCount + 1, 4).Formula = Not .UnRead
Cells(EmailCount + 1, 5).Formula = .SenderName
End With
Wend
Application.Calculation = xlCalculationAutomatic
Set OLF = Nothing
Columns("A:D").AutoFit
Range("A2").Select
ActiveWindow.FreezePanes = True
ActiveWorkbook.Saved = True
Application.StatusBar = False
End Sub

when I attempt to run, I get "object doesn't support this property or method" with
Cells(EmailCount + 1, 2).Formula = Format(.ReceivedTime, "ddd dd mmm yy hh:mm")

highlighted. Suspect this is just syntax related, though.

Would you know of a list of all the email attribute names somewhere?

Pete

 

[NewOrderFac33]

...and incidentally, this one drops out at row 69 too, again with "object doesn't support this property or method", highlightiing
Cells(EmailCount + 1, 2).Formula = .ReceivedTime

Just realised - the 69th item is a message recall!

How can I make it ignore these?

 

[boxboy30]

try referencing Excel as well to Outlook? Or open a blank page and then run it...which I don't think it is because I told it to run a new workbook each time

 

[NewOrderFac33]

I added an "On Error Resume Next" statement to both Outlook and Excel code and they both work fine, bypassing the message recall items nicely.
If I can now just work on something to work on the currently active message (without having to copy the message I want into a separate folder and processing that via the Outlook code that allows me to select a folder), that would be great!
Thanks for all your help, both.