Copy or Export Outlook Mail to Excel

Not open for further replies.

John Ferretti

New Member
Outlook version
Outlook 2013 32 bit
Email Account
Office 365 Exchange
Hi, I have a VBA Code to export incoming emails to excel and it does not work. If i paste the code, since i do not know what the items mean can someone highlight what i need to edit to cater it to the folder location of the excel file and other. I really just want to make a macro button in the email that extracts the date, name, and subject to excel so i can do it on a one off basis when i press the button.
Any error messages?

I have a code sample here - Macro to Export Outlook Fields to Excel - it works with one or more selected message.

Thanks Diane, your code worked. I think because the code I had didnt factor in for microsoft exchange.

Could you also help me change where it looks for the excel file? It is on a different drive in a subfolder not my user folder.

Also I do not need the body, just the subject and not sure what i can remove to get the subject.

Basically, I wanted the date in column A, Subject in Column E, sender in column N on the sheet i am using.

And if i create the radio button in outlook to run it will it automatically add the next email on the next line?
Actually I figured some stuff out, but it keeps overwriting the same row, it wont add a separate email to the next row.

Sub CopyToExcel()
Dim xlApp As Object
Dim xlWB As Object
Dim xlSheet As Object
Dim rCount As Long
Dim bXStarted As Boolean
Dim enviro As String
Dim strPath As String

Dim currentExplorer As Explorer
Dim Selection As Selection
Dim olItem As Outlook.MailItem
Dim obj As Object
Dim strColA, strColC, strColD, strColE, strColF As String

' Get Excel set up
enviro = CStr(Environ("USERPROFILE"))
'the path of the workbook
strPath = enviro & "\Documents\test.xlsx"
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Application.StatusBar = "Please wait while Excel source is opened ... "
Set xlApp = CreateObject("Excel.Application")
bXStarted = True
End If
On Error GoTo 0
'Open the workbook to input the data
Set xlWB = xlApp.Workbooks.Open(strPath)
Set xlSheet = xlWB.Sheets("Pipeline Agenda")
' Process the message record

On Error Resume Next
'Find the next empty line of the worksheet
rCount = xlSheet.Range("B" & xlSheet.Rows.Count).End(-4162).Row
'needed for Exchange 2016. Remove if causing blank lines.
rCount = rCount + 1

' get the values from outlook
Set currentExplorer = Application.ActiveExplorer
Set Selection = currentExplorer.Selection
For Each obj In Selection

Set olItem = obj

'collect the fields
strColA = olItem.ReceivedTime
strColC = olItem.SenderName
strColD = olItem.To
strColE = olItem.Subject
strColF = olItem.Categories

' Get the Exchange address
' if not using Exchange, this block can be removed
Dim olEU As Outlook.ExchangeUser
Dim oEDL As Outlook.ExchangeDistributionList
Dim recip As Outlook.Recipient
Set recip = Application.Session.CreateRecipient(strColC)

If InStr(1, strColC, "/") > 0 Then
' if exchange, get smtp address
Select Case recip.AddressEntry.AddressEntryUserType
Case OlAddressEntryUserType.olExchangeUserAddressEntry
Set olEU = recip.AddressEntry.GetExchangeUser
If Not (olEU Is Nothing) Then
strColC = olEU.PrimarySmtpAddress
End If
Case OlAddressEntryUserType.olOutlookContactAddressEntry
Set olEU = recip.AddressEntry.GetExchangeUser
If Not (olEU Is Nothing) Then
strColC = olEU.PrimarySmtpAddress
End If
Case OlAddressEntryUserType.olExchangeDistributionListAddressEntry
Set oEDL = recip.AddressEntry.GetExchangeDistributionList
If Not (oEDL Is Nothing) Then
strColC = olEU.PrimarySmtpAddress
End If
End Select
End If
' End Exchange section

'write them in the excel sheet
xlSheet.Range("A" & rCount) = strColA
xlSheet.Range("n" & rCount) = strColC
xlSheet.Range("d" & rCount) = strColD
xlSheet.Range("e" & rCount) = strColE
xlSheet.Range("f" & rCount) = strColF

'Next row
rCount = rCount + 1


xlWB.Close 1
If bXStarted Then
End If

Set olItem = Nothing
Set obj = Nothing
Set currentExplorer = Nothing
Set xlApp = Nothing
Set xlWB = Nothing
Set xlSheet = Nothing
End Sub
This would tell it to find the next line when you restart the macro - does B have a value? If not change it to a column that will always have a value - N maybe?
'Find the next empty line of the worksheet
rCount = xlSheet.Range("B" & xlSheet.Rows.Count).End(-4162).Row

if you are doing more than 1 email at a time, it should add all, because rcount will go up - but if you are adding one at a time, then it won't.

If it's not that, add debug.print rcount after each line beginning with rCount then open the immediate window (on view menu) and run the macro. Do the numbers increment up by one?

To run it automatically, you need to use a run a script version in rules or an itemadd version that watches the folder for new items. There is an itemadd on the page with this macro.
Diane, you are a life saver, last question, what lines do i change to get it to go to this folder and this file:
Folder Location is this, O: is not my user drive, but a shared network drive
O:\Lease Credit Request\z2017 Pipeline Reports
File is 2017 Pipeline.xlsx
This tells it to use the logged in user's docs folder:
strPath = enviro & "\Documents\test.xlsx"
change it to
strPath = "O:\Lease Credit Request\z2017 Pipeline Reports\test.xlsx"
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
C Copy from one Profile to another Using Outlook 0
M "Attachment Detacher for Outlook" add in, does it update the server copy of the email? Using Outlook 1
C Outlook 365 Copy/Save Emails in Folder Outside Outlook to Show Date Sender Recipient Subject in Header Using Outlook 0
D Copy Appointment Body to Task Body Outlook VBA and Custom Forms 0
M copy field value to custom field Outlook VBA and Custom Forms 0
O In Agenda-view - How to copy an existing item months ahead or back? Using Outlook 0
C Move or copy from field to field Outlook VBA and Custom Forms 0
Z Copy specific email body text Outlook VBA and Custom Forms 0
B Need to Copy an email to a subfolder Outlook VBA and Custom Forms 2
O Outlook 365 - How to create / copy a new contact from an existing one? Using Outlook 5
S Copy Tasks/Reminders from Shared Mailbox to Personal Tasks/Reminders Outlook VBA and Custom Forms 0
A Cannot copy this folder because it may contain private items Using Outlook 0
C Copy Move item won't work Outlook VBA and Custom Forms 2
Z VBA to convert email to task, insert text of email in task notes, and attach copy of original email Outlook VBA and Custom Forms 4
Commodore Move turns into "copy" Using Outlook 3
C Copy Outlook contact field value to another field Outlook VBA and Custom Forms 1
J Copy to calendar function no longer working in outlook 365 Using Outlook 5
F Copy and replace not update contact in another pst Using Outlook 0
B Outlook Business Contact Manager with SQL to Excel, User Defined Fields in BCM don't sync in SQL. Can I use VBA code to copy 1 field to another? BCM (Business Contact Manager) 0
Commodore Folders always closed in move/copy items dialog box Using Outlook 3
N Outlook rules don't create a copy for bcc'ed emails Using Outlook 3
geofferyh Outlook 2010 How to Copy Outlook Attachment to a Specific Folder? Outlook VBA and Custom Forms 3
S Custom Form, copy user field data to message body Outlook VBA and Custom Forms 12
R Copy Outlook Public Folders to a File Server Shared Folder Using Outlook 0
K Outlook Rules: Move a Copy Using Outlook 4
oliv- HOW TO COPY /USE FOLDERS ICONS Outlook VBA and Custom Forms 2
E Copy e-mail body from outlook and insert into excel Outlook VBA and Custom Forms 3
B Copy/Move Exchange inbox to Pop inbox Using Outlook 4
R Sending email copy (*.msg file) of sent email if subject line contains specific string. Outlook VBA and Custom Forms 1
O Copy mails from many subfolders to 1 foldr Using Outlook 2
K ind specific Subject line from outlook and copy the content of the email body to exce Outlook VBA and Custom Forms 0
K How to find specific header and copy the mail body Using Outlook 0
G Copy Contact field to Appointment Custom Form Field Outlook VBA and Custom Forms 2
G How to Copy Multi Select Listbox Data to Appointment Outlook VBA and Custom Forms 3
Carrie Dickey Outlook 2016 created two calendars titled Calendar1 - appear to be a copy Using Outlook 2
P How to copy and append data from Outlook 2016 message into Excel 2016 workbook Using Outlook 0
Stilgar Relsik Create a rule to copy text from an email and paste it in the subject line. Using Outlook 1
R Macro to copy email to excel - Runtime Error 91 Object Variable Not Set Outlook VBA and Custom Forms 11
H Macro to Copy Specific content from Mail Body and Paste to Excel Outlook VBA and Custom Forms 4
M How to keep reccurence during copy tasks to calendar? Using Outlook 1
Diane Poremsky Copy New Appointments to Another Calendar using VBA Using Outlook 0
Diane Poremsky Use a macro to copy data in Outlook email to Excel workbook Using Outlook 0
C Copy Task to Non-Microsoft PIM "Rainlendar" Using Outlook 0
G VBA Copy draft email to a new email - attachments not copided Using Outlook 7
C Copy email to excel runtime error 5020 Using Outlook 5
I Copy email from folder to folder - FAILS Using Outlook 5
M Copy new appointments created in multiple shared calendars to another exchange calendar Outlook VBA and Custom Forms 1
Q Why can't I copy image with embedded hyperlink from email to Word Using Outlook 0
I How to make a copy of a task Using Outlook 8
F copy data in Custom Field to other folder Outlook VBA and Custom Forms 2

Similar threads