Extract Text from body of outlook message to excel

scottluz

New Member
Joined
Dec 10, 2009
Messages
3
I have been trying to make a macro work for me, but the problem I am running into is that i cannot get the macro to grab the correct folder in Outlook. The macro I am running is as such:

Option Explicit

Sub ReadInbox()
Dim OutlookApp As Object
Dim OA_NameSpace As Object
Dim OA_Folder As Object
Dim OA_MailItem As Object

Dim ws As Worksheet

Dim Created As Boolean

Dim NextRecord As Long

Application.ScreenUpdating = False

Set ws = Workbooks.Add(xlWorksheet).Sheets(1)

ws.[A1] = "Name"
ws.[B1] = "E-mail"

NextRecord = 2

On Error Resume Next
Set OutlookApp = GetObject(, "Outlook.Application")
If OutlookApp Is Nothing Then
Set OutlookApp = CreateObject("Outlook.Application")
Created = True
If OutlookApp Is Nothing Then
MsgBox "Unable to start Outlook."
Exit Sub
End If
End If
On Error GoTo 0

Set OA_NameSpace = OutlookApp.GetNamespace("MAPI")
Set OA_Folder = OA_NameSpace.GetDefaultFolder(6)


OA_Folder.Items.Sort "Received", True

For Each OA_MailItem In OA_Folder.Items
If OA_MailItem Like "Chapter Downloaded" Then
Dim OrderInfo As Variant

OrderInfo = GrabInfo(OA_MailItem.Body)

If IsArray(OrderInfo) Then
ws.Range(Cells(NextRecord, 1), Cells(NextRecord, 5)) = OrderInfo
NextRecord = NextRecord + 1
End If
End If
Next

If Created Then OutlookApp.Quit

Application.ScreenUpdating = True

Set OA_Folder = Nothing
Set OA_NameSpace = Nothing
Set OutlookApp = Nothing
End Sub

Private Function GrabInfo(message As String) As Variant
Dim tmpInfo(4) As String

Dim f As Integer

Const TMPFILE As String = "C:\Temp\outlook_extraction.tmp"

If message = vbNullString Then GrabInfo = vbNullString: Exit Function

f = FreeFile

Open TMPFILE For Output As #f
Write #f, message
Close #f

f = FreeFile

Open TMPFILE For Input As #f

Do While Not EOF(f)
Dim tmpLine As String

Line Input #f, tmpLine

If InStr(1, tmpLine, ":") Then
Select Case UCase(Left(tmpLine, InStr(1, tmpLine, ":") - 1))
Case "Name =": tmpInfo(0) = SplitString(tmpLine, ":")
Case "E-Mail =": tmpInfo(1) = SplitString(tmpLine, ":")

End Select
End If
Loop

Close #f

Kill TMPFILE

GrabInfo = tmpInfo
End Function

Private Function SplitString(value As String, delimeter As String) As String
SplitString = Trim(Mid(value, InStr(1, value, delimeter) + 2, Len(value) - InStr(1, value, delimeter)))
End Function

End Function

The line I seem to be having trouble with is boldened and in orange. I believe this is the line that will go to the specific folder I am trying to use in my outlook folders. Any help on how to set this to the folder I want would be very helpful.
 

Some videos you may like

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,624
Set OA_NameSpace = OutlookApp.GetNamespace("MAPI")
Set OA_Folder = OA_NameSpace.GetDefaultFolder(6)

The line I seem to be having trouble with is boldened and in orange. I believe this is the line that will go to the specific folder I am trying to use in my outlook folders. Any help on how to set this to the folder I want would be very helpful.

Try:
Code:
Set OA_Folder= OA_NameSpace.Folders("Personal Folders").Folders("SubfolderName")

'To go down further subfolders just append .Folders() to the level required:
Set OA_Folder= OA_NameSpace.Folders("Personal Folders").Folders("SubfolderName").Folders("Sub-subfolder")
Or to display Outlook's 'Select Folder' dialogue box and use the selected folder:
Code:
Set OA_Folder= OA_NameSpace.PickFolder
 

scottluz

New Member
Joined
Dec 10, 2009
Messages
3
I am trying to use one of the folders in my mailbox, that is not a subfolder. In my mailbox I have 25 folders, and the one I want is the 5th folder in the column. I have not done macros in a long time and just am stumped on this and why it will not grab the information I want.
 

Watch MrExcel Video

Forum statistics

Threads
1,123,331
Messages
5,601,002
Members
414,419
Latest member
JRDunya

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top