How to copy and append data from Outlook 2016 message into Excel 2016 workbook

How to copy and append data from Outlook 2016 message into Excel 2016 workbook

  • http://www.slipstick.com/developer/code-samples/macro-export-outlook-fields-excel/#comment-197327

    Votes: 0 0.0%
  • http://www.slipstick.com/developer/vba-copy-outlook-email-excel-workbook/

    Votes: 0 0.0%

  • Total voters
    0
Status
Not open for further replies.

Pam Fim

New Member
Outlook version
Outlook 2016 64 bit
Email Account
Exchange Server
I'm new to working with VBA and need to copy data from multiple emails in a folder. I used the Use a macro to copy data in Outlook email to Excel workbook example to create the VBA code and it does not place the data in the Excel 2016 workbook for any emails in the Occupant folder.

Questions
1. Why is the data not placed in the test3.xlsx workbook from emails in the Occupant folder?
2. How can I update the VBA code to add multiple data sets in one email thread?
3. How do you update the code to update the test3.xlsx workbook as each time an email appears in the Occupant folder from new incoming email or an email moved or copied to the folder to appear in the next blank row of the test3.xlsx workbook?


Email data sample
Occupant-Company ID: 71xxxxx7-xxxx-xxxx-xxxx-8xxxxxxxxxxd
Occupant.COM: GoData2383405.GoData.com
Company name: Go Data
Domain(s): GoData.com; Data.com
Contact Name: Frank GoData
Contact Email Address: frank4@godata.com
Contact Phone Number: 999-978-9090

Option Explicit
Private objNS As Outlook.NameSpace
Private WithEvents objItems As Outlook.Items

Private Sub Application_Startup()

Dim objWatchFolder As Outlook.Folder
Set objNS = Application.GetNamespace("MAPI")

'Set the folder and items to watch:
' Use this for a folder in your default data file
Set objWatchFolder = objNS.GetDefaultFolder(olFolderInbox).Folders("Occupant")

' to watch a folder in a non-default data file
' see Working with VBA and non-default Outlook Folders for GetFolderPath Function
' Set objWatchFolder = GetFolderPath("me@domain.com\Inbox\Occupant")

Set objItems = objWatchFolder.Items

Set objWatchFolder = Nothing
End Sub


Private Sub CopyToExcel(olItem As Outlook.MailItem)
Dim xlApp As Object
Dim xlWB As Object
Dim xlSheet As Object
Dim vText, vText2, vText3, vText4, vText5, vText6, vText7 As Variant
Dim sText As String
Dim rCount As Long
Dim bXStarted As Boolean
Dim enviro As String
Dim strPath As String
Dim Reg1 As Object
Dim M1 As Object
Dim M As Object
Dim i As Integer
Dim strResult As String

enviro = CStr(Environ("USERPROFILE"))

'the path of the workbook
strPath = enviro & "\Documents\test3.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("Sheet1")

'Find the next empty line of the worksheet
rCount = rCount + 1

sText = olItem.Body
Set Reg1 = CreateObject("VBScript.RegExp")
For i = 1 To 7

With Reg1

Select Case i
' Occupant-Company ID: start entering data in cell A-2 or the next blank row
Case 1 ' include notes on text content format
.Pattern = "(Occupant-CompanyID\s[:]+\s*(\w*)\s*)\n"
.Global = False

' Occupant.Com(s): start entering data in cell B-2 or the next blank row
Case 2 ' include notes on text content format
.Pattern = "( Occupant.Com(s)\s[:]+\s*(\w*)\s*)\n"
.Global = False

' Company Name: start entering data in cell C-2 or the next blank row
Case 3 ' include notes on text content format
.Pattern = "(Company Name\s[:]+\s*(\w*)\s*)\n"
.Global = False

' Domain(s): start entering data in cell D-2 or the next blank row
Case 4 ' include notes on text content format
.Pattern = "(Domain(s)\s[:]+\s*(\w*)\s*)\n"
.Global = False

' Contact Name: start entering data in cell E-2 or the next blank row
Case 5
.Pattern = "(Contact Name\s[:]+\s*(\w*)\s*)\n"
.Global = False

' Email Address: start entering data in cell F-2 or the next blank row
Case 6
.Pattern = "(Email Address\s[:]+\s*(\w*)\s*)\n"
.Global = False

' Contact Phone Number: start entering data in cell G-2 or the next blank row
Case 7
.Pattern = "(Contact Phone Number\ s*(.*))\n "
.Global = False

End Select

End With

If Reg1.Test(sText) Then

Set M1 = Reg1.Execute(sText)
For Each M In M1

Debug.Print M.SubMatches(1)
strResult = M.SubMatches(1)
If i = 1 Then vText = strResult
If i = 2 Then vText2 = strResult
If i = 3 Then vText3 = strResult
If i = 4 Then vText4 = strResult
If i = 5 Then vText5 = strResult
If i = 6 Then vText6 = strResult
If i = 7 Then vText7 = strResult

Next
End If
Next i
Debug.Print vText
Debug.Print "1: " & vText
Debug.Print "2: " & vText2
Debug.Print "3: " & vText3
Debug.Print "4: " & vText4
Debug.Print "5: " & vText5
Debug.Print "6: " & vText6
Debug.Print "7: " & vText7

xlSheet.Range("A" & rCount) = vText
xlSheet.Range("B" & rCount) = vText2
xlSheet.Range("C" & rCount) = vText3
xlSheet.Range("D" & rCount) = vText4
xlSheet.Range("E" & rCount) = vText5
xlSheet.Range("F" & rCount) = vText6
xlSheet.Range("G" & rCount) = vText7

xlWB.Close 1
If bXStarted Then
xlApp.Quit
End If
Set M = Nothing
Set M1 = Nothing
Set Reg1 = Nothing
Set xlApp = Nothing
Set xlWB = Nothing
Set xlSheet = Nothing
End Sub


Sub TestMacro()
Dim olItem As Outlook.MailItem
Set olItem = Application.ActiveExplorer.Selection.Item(1)
CopyToExcel olItem
End Sub
 
Status
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
J Copy or Export Outlook Mail to Excel Outlook VBA and Custom Forms 6
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
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

Back
Top