Linking Outlook to Excel

barrowb

Board Regular
Joined
Dec 15, 2011
Messages
97
I found this code to link Outlook to Excel but I keep getting a compile error. It says "User-defined type not defined."

Please help. This is the website i got the instructions from.





Sub ExportToExcel()
On Error GoTo ErrHandler

Dim appExcel As Excel.Application

Dim wkb As Excel.Workbook

Dim wks As Excel.Worksheet

Dim rng As Excel.Range

Dim strSheet As String

Dim strPath As String

Dim intRowCounter As Integer

Dim intColumnCounter As Integer

Dim msg As Outlook.MailItem

Dim nms As Outlook.NameSpace

Dim fld As Outlook.MAPIFolder

Dim itm As Object
strSheet = "OutlookItems.xls"
strPath = "C:Examples\"

strSheet = strPath & strSheet

Debug.Print strSheet
'Select export folder
Set nms = Application.GetNamespace("MAPI")

Set fld = nms.PickFolder
'Handle potential errors with Select Folder dialog box.
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
'Open and activate Excel workbook.
Set appExcel = CreateObject("Excel.Application")

appExcel.Workbooks.Open (strSheet)

Set wkb = appExcel.ActiveWorkbook

Set wks = wkb.Sheets(1)

wks.Activate

appExcel.Application.Visible = True
'Copy field items in mail folder.
For Each itm In fld.Items

intColumnCounter = 1

Set msg = itm

intRowCounter = intRowCounter + 1

Set rng = wks.Cells(intRowCounter, intColumnCounter)

rng.Value = msg.To

intColumnCounter = intColumnCounter + 1

Set rng = wks.Cells(intRowCounter, intColumnCounter)

rng.Value = msg.SenderEmailAddress

intColumnCounter = intColumnCounter + 1

Set rng = wks.Cells(intRowCounter, intColumnCounter)

rng.Value = msg.Subject

intColumnCounter = intColumnCounter + 1

Set rng = wks.Cells(intRowCounter, intColumnCounter)

rng.Value = msg.SentOn

intColumnCounter = intColumnCounter + 1

Set rng = wks.Cells(intRowCounter, intColumnCounter)

rng.Value = msg.ReceivedTime

Next itm
Set appExcel = Nothing
Set wkb = Nothing

Set wks = Nothing

Set rng = Nothing

Set msg = Nothing

Set nms = Nothing

Set fld = Nothing

Set itm = Nothing
Exit Sub
ErrHandler: If Err.Number = 1004 Then

MsgBox strSheet & " doesn't exist", vbOKOnly, _
"Error"

Else

MsgBox Err.Number & "; Description: ", vbOKOnly, _
"Error"

End If

Set appExcel = Nothing

Set wkb = Nothing

Set wks = Nothing

Set rng = Nothing

Set msg = Nothing

Set nms = Nothing

Set fld = Nothing

Set itm = Nothing
End Sub
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
Thanks, that worked.

I now would like it to automatically select a folder instead of me manually selecting it. The folder name is "Budget"

Thanks in advance
 
Upvote 0

Forum statistics

Threads
1,213,561
Messages
6,114,316
Members
448,564
Latest member
ED38

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
Back
Top