Extract Outlook emails to excel

nicola204

New Member
Outlook version
Outlook 2013 32 bit
Email Account
IMAP
Hi, new to the forum and new to VBA, please can someone help me with this, it's driving me crazy.

All i want to do is extract all the emails that come into my outlook into an excel file every time i run the macro.

All i want is

The date & time the email was received
The Subject 'title' of the email.
The body of the email.
The Sender of the email.

I've tried this code below, which works fine to a degree, except the date/time format when it appears in my excel doesn't match across all my emails.

14/02/2020 07:30:12
02/12/2020 12:40​

every time i try and change the order of the code, putting the time first, the subject next line, and i save the new macro, it still seems to run to order
Sender NameSender EmailSubjectBodySent ToDate

What am i doing wrong? I'm a complete beginner with VBA so please be patient with me.

Please can someone help me?

Option Explicit

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 objOL As Outlook.Application

Dim objFolder As Outlook.MAPIFolder

Dim objItems As Outlook.Items

Dim obj As Object

Dim olItem 'As Outlook.MailItem

Dim strColA, strColB, strColC, strColD, strColE, strColF As String



' Get Excel set up

enviro = CStr(Environ("USERPROFILE"))

'the path of the workbook

strPath = enviro & "\Documents\Book1.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



On Error Resume Next

' Open the workbook to input the data

' Create workbook if doesn't exist

Set xlWB = xlApp.Workbooks.Open(strPath)

If Err <> 0 Then

Set xlWB = xlApp.Workbooks.Add

xlWB.SaveAs FileName:=strPath

End If

On Error GoTo 0

Set xlSheet = xlWB.Sheets("Sheet1")



On Error Resume Next

' add the headers if not present

If xlSheet.Range("A1") = "" Then

xlSheet.Range("A1") = "Sender Name"

xlSheet.Range("B1") = "Sender Email"

xlSheet.Range("C1") = "Subject"

xlSheet.Range("D1") = "Body"

xlSheet.Range("D1") = "Date"



End If



'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 objOL = Outlook.Application

Set objFolder = objOL.ActiveExplorer.CurrentFolder

Set objItems = objFolder.Items

For Each obj In objItems



Set olItem = obj



'collect the fields



strColA = olItem.SenderName

strColB = olItem.SenderEmail

strColC = olItem.Subject

strColD = olItem.To

strColE = olItem.ReceivedTime


'write them in the excel sheet

xlSheet.Range("A" & rCount) = strColA

xlSheet.Range("B" & rCount) = strColB

xlSheet.Range("C" & rCount) = strColC

xlSheet.Range("D" & rCount) = strColD

xlSheet.Range("E" & rCount) = strColE

xlSheet.Range("f" & rCount) = strColF

'Next row

rCount = rCount + 1

xlWB.Save


Next



' don't wrap lines

xlSheet.Rows.WrapText = True



xlWB.Save

xlWB.Close 1

If bXStarted Then

xlApp.Quit

End If



Set olItem = Nothing

Set obj = Nothing

Set xlApp = Nothing

Set xlWB = Nothing

Set xlSheet = Nothing

End Sub
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
These are the fields that control the order - you need to make sure the str matches the range -
strColA = olItem.SenderName
strColB = olItem.SenderEmail
strColC = olItem.Subject
>> body goes in Col D
strColD = olItem.To
strColE = olItem.ReceivedTime


xlSheet.Range("A" & rCount) = strColA
xlSheet.Range("B" & rCount) = strColB
xlSheet.Range("C" & rCount) = strColC
xlSheet.Range("D" & rCount) = olItem.Body <<= body here
xlSheet.Range("E" & rCount) = strColD
xlSheet.Range("F" & rCount) = strColE

Don;t forget to change the header row -
xlSheet.Range("A1") = "Sender Name"
xlSheet.Range("B1") = "Sender Email"
xlSheet.Range("C1") = "Subject"
xlSheet.Range("D1") = "Body"
xlSheet.Range("E1") = "Sent To"
xlSheet.Range("F1") = "Date"


Although its considered better form and faster to use variables, you can add the fields in the ranges, instead of the variables - or use better names for the variables
xlSheet.Range("A" & rCount) = olItem.SenderName
xlSheet.Range("B" & rCount) = olItem.SenderEmail
xlSheet.Range("C" & rCount) = olItem.Subject
xlSheet.Range("D" & rCount) = olItem.Body
etc

or use better variable names -
strName = olItem.SenderName
strEmail= olItem.SenderEmail
strSubject = olItem.Subject
strBody =olItem.Body
etc

xlSheet.Range("A" & rCount) = strName
xlSheet.Range("B" & rCount) = strEmail
xlSheet.Range("C" & rCount) = strSubject
xlSheet.Range("D" & rCount) = strBody


on the time, it looks like one is not seen as a time/date - try using format to make the time and date format the same for all.
strColE = format(olItem.ReceivedTime, "mm/dd/yyyy hh:mm AM/PM")
 

nicola204

New Member
Outlook version
Outlook 2013 32 bit
Email Account
IMAP
Thanks for the rapid reply. I'm gonna give it a whirl and see if i can amend the code and get it to work.
 
Thread starter Similar threads Forum Replies Date
M HELP - Can't open outlook... How can I extract my Emails that I had in folders Using Outlook 3
M Extract all links from Outlook email, send to Excel Using Outlook 2
T Extract Data From Outlook Tasks Using Outlook 0
T Extract Data From Outlook Tasks Using Outlook 0
K Extract email address from body and auto-reply outlook Using Outlook 1
R Trying to extract information between two symbols from outlook subject Using Outlook 2
E Extract excel files from outlook Outlook VBA and Custom Forms 2
K extract certain text from an Outlook Email Message Outlook VBA and Custom Forms 2
M HELP--Extract Data from 2003 outlook transfer to excel spreadsheet Using Outlook 1
M VBA Code to extract data from an Outlook Form Using Outlook 0
E I am trying to extract the email adress's i have in outlook. These are not saved 'contacts' these are ones from auto fill. When i open up an email, an Using Outlook 1
R Saving Outlook Email As Text File Extract Outlook VBA and Custom Forms 2
S How to extract outlook calendar data. Outlook VBA and Custom Forms 3
? outlook attachment Extract File ??? Outlook VBA and Custom Forms 1
V extract users of a particular department Outlook VBA and Custom Forms 1
J Outlook 2013 Extract Flag Completed dates to Excel Macro Outlook VBA and Custom Forms 16
S How to extract mail items from multiple folders and shared mailboxes? Outlook VBA and Custom Forms 0
K Extract email to excel from a specific sender Outlook VBA and Custom Forms 3
O VBA to extract email (fields and body) to Excel Outlook VBA and Custom Forms 14
P Recover / Extract Rules from standalone PST file creating RWZ file Using Outlook 2
B Extract Dates for Appointment Item in Body of email Outlook VBA and Custom Forms 10
D Need to extract a line from a word attachment, and add it to the subject line Outlook VBA and Custom Forms 3
D VBA Script to extract text matching specific criteria Outlook VBA and Custom Forms 1
M Extract text in existing message body for use in newmail items Using Outlook 17
M Extract attachments with a script Using Outlook 0
H Extract emails from Outlokk 2007 email body Using Outlook 0
K Extract Global Address List Using Outlook 1
L How to extract table format of Task Item if its body contains formatted table. Exchange Server Administration 1
D Extract email addresses from inbox in a batch and move them into "bcc" for a mass email campaign Using Outlook 1
M Extract, zip and replace attachement in each message of a pst file Using Outlook 0
N Programming to extract automatically extract attachments Outlook VBA and Custom Forms 3
D Extract Data from OST File Using Outlook 2
N How to extract date and time stamp from messsages Outlook VBA and Custom Forms 6
V Extract Subject,Sent From, Message from mailbox to Excel Outlook VBA and Custom Forms 5
S Automatically extract attachments? Outlook VBA and Custom Forms 1
I How to extract email addresses from TO or CC line of a particular email Outlook VBA and Custom Forms 2
B Outlook 2013 erratically deleting original file that is attached Using Outlook 0
V Outlook Forms: Formatting a Label with 2 different styles Outlook VBA and Custom Forms 1
M Outlook 2016 Outlook randomly unhides from taskbar Using Outlook 0
X Using Outlook 2013 and Outlook 365 Using Outlook 1
V Date and/or time error in Outlook Form Outlook VBA and Custom Forms 0
D Sending email from Office 365 alias in Outlook Using Outlook 4
B Spam folder not showing in Outlook Using Outlook 5
ThinkToday Calculate reply time of outlook mail Using Outlook 1
M Microsoft 365 Outlook keeps requesting password on Local Account Using Outlook 1
I Outlook 365 - import/attach PST file that used POP3 Using Outlook.com accounts in Outlook 0
e_a_g_l_e_p_i I think it may be time to upgrade from Outlook 2010 Using Outlook 3
K Outlook 2016 Outlook, Chrome, and Clio Using Outlook 5
O Outlook tasks - Add text column with multiple lines Using Outlook 3
A Run-time error '430' on certain emails when trying to set "Outlook.mailitem" as "ActiveExplorer.Selection.Item" Outlook VBA and Custom Forms 2
Similar threads


















































Top