Extract Outlook emails to excel

Status
Not open for further replies.
N

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
 
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")
 
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.
 
Status
Not open for further replies.
< Replyin to the reply-to email address | Saving attachments from multiple emails and updating file name >
Similar threads
Thread starter Title Forum Replies Date
M HELP - Can't open outlook... How can I extract my Emails that I had in folders Using Outlook 3
S Unable to extract text from an Outlook email message Using Outlook 2
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
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
C Wishlist Extract or scan new email addresses from out of office replies. Leads from OOO replies Using Outlook 1
D ISOmacro to extract active mail senders name and email, CC, Subject line, and filename of attachments and import them into premade excel spread sheet Outlook VBA and Custom Forms 2
M Extract "Date sent" from emails (saved to folder using drag and drop) Outlook VBA and Custom Forms 1
T vba extract data from msg file as attachment file of mail message Outlook VBA and Custom Forms 1
S Macro to extract and modify links from emails Outlook VBA and Custom Forms 3
S Macro to extract email addresses of recipients in current drafted email and put into clipboard Outlook VBA and Custom Forms 2
C Macro to extract sender name & subject line of incoming emails to single txt file Outlook VBA and Custom Forms 3
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
N Programming to extract automatically extract attachments Outlook VBA and Custom Forms 3
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
M Duplicate removal feature in Outlook 2021 is faulty Using Outlook 0
D.Moore Outlook COM addins source folder Using Outlook 2
P Removing Outlook 365 Account from Send/Receive Using Outlook 1
kburrows Outlook Automatically Merging Contacts Using Outlook 1
A Outlook 2016 Outlook 2016 vs. New Outlook Using Outlook 4
D Outlook Desktop App Email Software Using Outlook 0
efire9207 VBA Outlook Contacts Outlook VBA and Custom Forms 6
M Outlook not logging in to server Using Outlook 0
J Outlook macro to run before email is being send Outlook VBA and Custom Forms 0
R Outlook 2021 change view Using Outlook 2
K Outlook font corrupted in some point sizes, resets on close/open Using Outlook 2

Similar threads

Back
Top