Vba macro export from outlook to excel

jamilm

Well-known Member
Joined
Jul 21, 2011
Messages
740
Dear All,

I have been using the below code for exporting the outloook messages to Excel, this code was working with office 2007 , however when i upgraded my software to Ms office 2010 and when i run this macro, i get an error on "Dim appExcel As Excel.Application" the error pops " Compile Error User-defined type is not defined"

i would greatly appreciate your help as usual.

thanks.

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 i As Integer
Dim j As Integer
Dim lngCount As Long
Dim msg As Outlook.MailItem
Dim rep As Outlook.ReportItem
Dim nms As Outlook.NameSpace
Dim fld As Outlook.MAPIFolder
'Must declare as Object because folders may contain different
'types of items
Dim itm As Object
Dim strTitle As String
Dim strPrompt As String
Dim Proceed

Dim fYear, rYear, iMonth As Integer
Dim rMonth As String
Set appExcel = CreateObject("Excel.Application")
Workbooks.Add
Set wkb = appExcel.ActiveWorkbook
Set wks = wkb.Sheets(1)
wks.Activate
appExcel.Application.Visible = True
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Email"


'Adjust i (row number) to be 1 less than the number of the first body row
i = 1
j = 1

'Create Header Row

Set rng = wks.Cells(i, j)
rng.Value = "Subject"
j = j + 1

Set rng = wks.Cells(i, j)
rng.Value = "Body"
j = j + 1

Set rng = wks.Cells(i, j)
rng.Value = "FromName"
j = j + 1

Set rng = wks.Cells(i, j)
rng.Value = "ToName"
j = j + 1

Set rng = wks.Cells(i, j)
rng.Value = "Importance"
j = j + 1

Set rng = wks.Cells(i, j)
rng.Value = "Sensitivity"

Proceed = MsgBox("Export for Misc Test?", vbYesNo, "Misc Test?")

If Proceed = 7 Then

''Calculate the fiscal year
If Month(Date) = 12 Then
fYear = Year(Date) + 1
Else
fYear = Year(Date)
End If

'Calculate the report calendar year and report month
If Month(Date) = 1 Then
rYear = Year(Date) - 1
iMonth = 12
Else
rYear = Year(Date)
iMonth = Month(Date) - 1
End If

If iMonth < 10 Then
rMonth = "0" & iMonth
Else
rMonth = iMonth
End If

ActiveWorkbook.SaveAs "\\C:\Users\jamilm\JDSN Monthly E-mail Metrics\FY" _
& fYear & "\" & rMonth & "." & rYear, 51


Else

appExcel.DisplayAlerts = False
ActiveWorkbook.SaveAs "C:\Users\jamilm\misc.xls"
appExcel.DisplayAlerts = True

End If
'Let user select a folder to export
Set nms = Application.GetNamespace("MAPI")
Set fld = nms.PickFolder
If fld Is Nothing Then
GoTo ErrorHandlerExit
End If

'Test whether selected folder contains mail messages
If fld.DefaultItemType <> olMailItem Then
MsgBox "Folder does not contain mail messages"
GoTo ErrorHandlerExit
End If

lngCount = fld.Items.Count

If lngCount = 0 Then
MsgBox "No messages to export"
GoTo ErrorHandlerExit
End If



'Iterate through items in the folder, and export a few fields
'from each item to a row in the worksheet
For Each itm In fld.Items
If itm.Class = olMail Then

Set msg = itm
'i is the row number
i = i + 1
'j is the column number
j = 1

Set rng = wks.Cells(i, j)
If msg.Subject <> "" Then rng.Value = msg.Subject
j = j + 1

Set rng = wks.Cells(i, j)
If msg.Body <> "" Then rng.Value = msg.Body
j = j + 1

Set rng = wks.Cells(i, j)
If msg.SenderName <> "" Then rng.Value = msg.SenderName
j = j + 1

Set rng = wks.Cells(i, j)
If msg.To <> "" Then rng.Value = msg.To
j = j + 1

Set rng = wks.Cells(i, j)
rng.Value = msg.Importance
j = j + 1

Set rng = wks.Cells(i, j)
rng.Value = msg.Sensitivity

Else

Set rep = itm
'i is the row number
i = i + 1
'j is the column number
j = 1

Set rng = wks.Cells(i, j)
If rep.Subject <> "" Then rng.Value = rep.Subject
j = j + 1

Set rng = wks.Cells(i, j)
If rep.Body <> "" Then rng.Value = rep.Body
j = j + 3

Set rng = wks.Cells(i, j)
rng.Value = msg.Importance
j = j + 1

Set rng = wks.Cells(i, j)
rng.Value = msg.Sensitivity

End If
Next itm
Range("B:B").Select
Selection.WrapText = False

ActiveWorkbook.Save
ActiveWorkbook.Close
appExcel.Quit

Set appExcel = Nothing
Set wkb = Nothing
Set wks = Nothing
Set rng = Nothing
Set msg = Nothing
Set rep = Nothing
Set nms = Nothing
Set fld = Nothing
Set itm = Nothing

ErrorHandlerExit:
Exit Sub

ErrorHandler:
If Err.Number = 429 Then
'Application object is not set by GetObject; use CreateObject instead
If appExcel Is Nothing Then
Set appExcel = CreateObject("Excel.Application")
Resume Next
End If
Else
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description

Resume ErrorHandlerExit
End If

End Sub
 
i am sorry, i am not familiar with the term, can you please be more specific? maybe i am missing something here.

thanks very much
 
Upvote 0
Select your project in the Visual Basic Editor and choose Tools|References. Locate and check Microsoft Excel 14.0 Object Library and click OK.

Incidentally, in what application is your code?
 
Upvote 0
thanks a million Andrew. you guys are great. i owe you a bottle of champagne. i located the object EXCEL.exe in excel office14 library and then the macro worked.

many many thanks again.

i was running the project into outlook software.
 
Upvote 0

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