VBA Coding to Export Fields from Emails in Outlook to Excel (Help me!!!!!)

[Eman1234]

I have little to no experience using VBA so I found a sample of code that would allow me to select a folder in Outlook and export that data into Excel. The folder selection box pops up consistently and it opens the file I selected, so that is good. I have tried doing so many things to the code to get it to function properly, but to no avail. One attempt where I removed all of the error handling stuff allowed me to export certain folders, but I still got error messages for some of the other ones. I'm thinking it might have something to do with "Dim msg As Outlook.MailItem". Every time I try to select a folder it says "There are no mail messages to export". I have received error messages: 13, 438, and 50290. The code is posted below. Your help is greatly appreciated.

-Eric

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 = "Copy of Archive Completed Messages.xlsx"
    strPath = "C:\Users\Documents\"
strSheet = strPath & strSheet
Debug.Print strSheet
 
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
 
Set appExcel = CreateObject("Excel.Application")
appExcel.Workbooks.Open (strSheet)
Set wkb = appExcel.ActiveWorkbook
Set wks = wkb.Sheets(1)
wks.Activate
MsgBox "There are no mail messages to export", vbOKOnly, "Error"
appExcel.Application.Visible = True
 
 
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.SenderName
intColumnCounter = intColumnCounter + 1
Set rng = wks.Cells(intRowCounter, intColumnCounter)
rng.Value = msg.LastModificationDate
intColumnCounter = intColumnCounter + 1
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

[PhilOfWalton]

Eric, I am confused.

This has been posted on the Access Forum, and yet deals with Excel

Your Question is unclear. Do yo want to Export from Outlook and Import into Excel. or Export from Excel and Import into Outlook.

The info I gave you on a previous post just links an Outlook folder to Access so gives the illusion that you are Exporting from Outlook and Importing into Excel.
The 2 queries then put that data into a table.

Excel is not my forte, but I suspect you can do something similar, but I wouldn't be surprised if you get lots of duplicate messages.

Phil

[Eman1234]

Oops! Sorry about that Phil. Thank you for being the only person to respond to me on these things. So, what my boss wants is the report in access, which you helped me with and works great. However, he wants me to create a code to export Outlook folders directly into Excel so that they can run additional analysis on the emails.

Eric

[PhilOfWalton]

Why Excel & not Access?

Phil