Outlook body to Excel Document

Status
Not open for further replies.
comment out this line - i was thinking it was for the connection outlook opened (silly me, it's not a database :)) , but it's closing the workbook. We want the workbook open so it runs faster.
xlWB.Close 1

and comment out the End if - it goes with these lines.
If bXStarted Then
xlApp.Quit
 
This is the current code, I'm getting a message with the following. SGNCCIPS.xls is already open, reopening will cause any changes you made to be discarded. do you want to reopen sgnccips.xls Yes / No. This is on a dialogue box.




Also, it only seems to be running on messages selected, I'm guessing this is for testing purposes.




Code:
Option Explicit
Sub CopyToExcel(olItem As Outlook.MailItem)
Dim xlApp As Object
Dim xlWB As Object
Dim xlSheet As Object
Dim vText, vText2, vText3, vText4, vText5 As Variant
Dim sText As String
Dim vItem As Variant
Dim i As Long
Dim rCount As Long
Dim bXStarted As Boolean
Const strPath As String = "C:\SGNCCIPS\SGNCCIPS.xls"        'the path of the workbook
    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("Test")
   ' Process the message record
   Set olItem = Application.ActiveExplorer().Selection(1)
   
   'Find the next empty line of the worksheet
    rCount = xlSheet.Range("B" & xlSheet.Rows.Count).End(-4162).Row
    rCount = rCount + 1
    
 
 
' may not be needed
 
 
sText = ""
 
 
vText = ""
 
 
vText2 = ""
 
 
vText3 = ""
 
 
vText4 = ""
 
 
vText5 = ""
 
 

    sText = olItem.Body
    
    
   Dim Reg1 As RegExp
   Dim M1 As MatchCollection
   Dim M As Match
        
  ' Debug.Print olMail.Body
    
   Set Reg1 = New RegExp
    
   ' \s* = invisible spaces
   ' \d* = match digits
   ' \w* = match alphanumeric
    
   With Reg1
 
 
'we could use d instead of w- if last value is more than 1 digit, use \d*
       .Pattern = "((P130\w*)\s*(\w*)\s*(\w*)\s*(\w*)\s*([\d-\.]*))"
       '.Global = True
   End With
   If Reg1.Test(sText) Then
    
       Set M1 = Reg1.Execute(sText)
       For Each M In M1
          vText = Trim(M.SubMatches(1))
          vText2 = Trim(M.SubMatches(2))
          vText3 = Trim(M.SubMatches(3))
          vText4 = Trim(M.SubMatches(4))
          vText5 = Trim(M.SubMatches(5))
       Next
   End If
 
 

 xlSheet.Range("B" & rCount) = vText
 xlSheet.Range("c" & rCount) = vText2
 xlSheet.Range("d" & rCount) = vText3
 xlSheet.Range("e" & rCount) = vText4
 xlSheet.Range("f" & rCount) = vText5
 
 

 
 
'     xlWB.Close 1
 '   If bXStarted Then
  '      xlApp.Quit
   
' could do other things- mark read etc
' we want to see which ones the code touched
  olItem.Categories = "processed"
  olItem.Save
 
 

 
 
'     End If
 
 
Set Reg1 = Nothing
    Set xlApp = Nothing
    Set xlWB = Nothing
    Set xlSheet = Nothing
End Sub
 
This line > Sub CopyToExcel(olItem As Outlook.MailItem)
should cause it to only work as a run a script rule.

on the error, I'm sure it's related to these lines - try uncommenting the close line (leave the if... end if commented out) and see if it works. You can try changing it to xlWB.Save and see if the error comes back.
xlWB.Close 1
' If bXStarted Then
' xlApp.Quit

' End If
 
I tried the XlWB.Save and that caused the same error.

It still only seems to process the message you are highlighting.
 
Sorry got that wrong, it processes all items, but only does the catagories colour on the selected item.

It processed as follows.

P130600522 100329 ACTI099 201 199.5

P130600522 100329 ACTI099 201 199.5

P130600522 100329 ACTI099 201 199.5

P130600522 100329 ACTI099 201 199.5

P130600522 100329 ACTI099 201 199.5

P130600522 100329 ACTI099 201 199.5

So it picks up the first file.
 
So its still not clearing the values on multiple messages? We can try switching to EntryIDs and using newmailex from http://www.outlookcode.com/article.aspx?id=62

on the close/save stuff - it looks like the code as written needs to use the close statement. When i get a chance I'll look at changing the code so it keeps it open - but it may still not be fast enough to process a large number of messages at once.
 
Hi Diane

It basically just repeated the first value, it did repeat it the same amount of times as emails that had been processed.

I'm happy for any help so whenever you get a chance to change the code i'm happy. Its not mega urgent and if you feel its too much work just say.

Regards

Wayne
 
Hi Diane

It basically just repeated the first value, it did repeat it the same amount of times as emails that had been processed.

I'm happy for any help so whenever you get a chance to change the code i'm happy. Its not mega urgent and if you feel its too much work just say.

Regards

Wayne
Hi Diane, I am having the same issue where it won't process multiple emails arriving quickly. If I forward to myself (with the appropriate rule) and wait as each one is received then the script works. If you can help with the solution you mention above that would be great! But, you do mention it still might not work. What about a rule where I forward it but it delays each forward 10 seconds to allow the script to process?
 
Well, it could either be one of the limitations of run a script rules or a factor in how slow it is. It's definitely faster to not close the workbook and reopen it.

You can try converting it to an item add macro, but will need to either use a rule to move the messages to another folder and watch that folder or you'll have to set up an if statement in the macro.
 
Hi Diane

It basically just repeated the first value, it did repeat it the same amount of times as emails that had been processed.

I'm happy for any help so whenever you get a chance to change the code i'm happy. Its not mega urgent and if you feel its too much work just say.

Regards

Wayne

If you need to pick up multiple values from a message, you need to move the code that writes to the sheet inside the For... next statement
Code:
  If Reg1.Test(sText) Then
  Set M1 = Reg1.Execute(sText)
  For Each M In M1
  vText = Trim(M.SubMatches(1))
  vText2 = Trim(M.SubMatches(2))
  vText3 = Trim(M.SubMatches(3))
  vText4 = Trim(M.SubMatches(4))
  vText5 = Trim(M.SubMatches(5))

   xlSheet.Range("B" & rCount) = vText
   xlSheet.Range("c" & rCount) = vText2
   xlSheet.Range("d" & rCount) = vText3
   xlSheet.Range("e" & rCount) = vText4
   xlSheet.Range("f" & rCount) = vText5
Next
     End If
 
Dear Diane,

first of all thanks a ton for all the valuable advice! You don't know how much time you saved me and my colleagues at work :)

Now, there is one thing that I cannot get right, so here's my case study:
a) Every day I get 50-100 e-mails from an automated form, with the following elements in the body:

Kontakt osoba jozukić p25
Dodatni tekst mislim da bi bilo dobro da imamo barem jedan komad na nivou firme,štop prekidač,meni konkretno treba za antaru,ali vidim da ide i na druga vozila
Broj proizvoda 700424
Šifra dobavljačevog artikla 700424-VAL
Korisnik :
ciakp25

so, my goal is to extract the information from every single field into an excel sheet, everything in its column. The potential issue is the last one where it's not in the same line, but the pattern recognition is "Korisnik :", and the result is in another line.

So far I've been combining (unsuccessfully) these two threads:
Use a macro to copy data in Outlook email to Excel workbook
Use RegEx to extract text from an Outlook email message

But when I enter and edit everything in the project (both in object and add the module - and my excel sheet is opened in Documents under Korisnik.xlsx), it doesn't work.

The e-mails always have the same sender (noreply@carparts-cat.com) and the same receiver (nabava@ciak-auto.hr), out of which I already created a rule to move it to a specified folder. Of course, if I use the run rule as script I need to make it the only rule, so this one that I mentioned cannot co-exist with "run rule as script". Or could it?
Additional level of complexity might be that I'm already getting orders everyday from noreply@carparts-cat.com, but that's related to another email account (narudzbe@ciak-auto.hr). Also, this e-mail nabava@ciak-auto.hr which I'm receiving is an e-mail group on MS Exchange.

All in all, if the first step can be done (extract the patterns to Excel), I don't mind the clutter in my Inbox. Even if I cannot transfer this "Korisnik :", it's not an issue.

If you find time in the next week or so, I would really appreciate your help.
It's office 2010, and MS Ex account (dominik.leko@ciak-auto.hr).

Thanks, best regards,
Dominik
 
so, my goal is to extract the information from every single field into an excel sheet, everything in its column. The potential issue is the last one where it's not in the same line, but the pattern recognition is "Korisnik :", and the result is in another line.

So Korisnik : is in the message twice and the regex gets the wrong one? Try setting .global. True will return the last one, False = first one. If it's in the middle and the pattern is like this, on two lines (and any others are on one line) , try adding \r or \n to the pattern where the line break is.
Korisnik :
ciakp25


With Reg1
.Pattern =
.Global = True
End With

Is this the only issue or is the script just not working at all?
 
The script is just not working.
Korisnik : is appearing only once so it's not a proble (maybe I wasn't too clear on this).
 
ok... so it's just that it is on two lines. try a pattern like Korisnik :\s\n(.*)

This pattern worked on the email version of message #31 above -
Code:
    With Reg1
        .Pattern = "(Korisnik :\s*\n(\w*))"
        .Global = True
    End With

Not knowing exactly how the end of the line is formatted (extra spaces etc), it might need a little tweaking.
 
Hi Diane,

thanks, it will be a bit of tweaking probably but it will be fine I think.
What do you say about the other parts of the post - should I dismiss all the rules except run rule as script?

In general, I'm not sure I did everything right since it's not working - do you have an idea how exactly should the whole script look like, based on what I've written and two of your excellent posts which I linked?

Thanks a lot again,

BR
Dominik
 
If the patterns aren't correct, work with the macros on this page - Use RegEx to extract text from an Outlook email message - select a message and run the macro. Debug.print to see the results of the pattern. After you get the patterns correct, then work on sending the data to excel. This will make debugging it much easier.

You should use case statements with the patterns - you'll need to use more than 3...

Code:
Sub GetValueUsingRegEx()
  Dim olMail As Outlook.MailItem
  Dim Reg1 As RegExp
  Dim M1 As MatchCollection
  Dim M As Match
  Dim var 'As String
  Set olMail = Application.ActiveExplorer().Selection(1)
  Set Reg1 = New RegExp

For i = 1 To 3

With Reg1
  Select Case i
  Case 1
  .Pattern = "(Kontakt osoba(.*)\s*\r)"
  .Global = False
  Case 2

  .Pattern = "(artikla \s*(.*)\r)"
  .Global = False
  Case 3
  .Pattern = "(Korisnik :\s*\n(\w*))"
  .Global = False
  End Select
End With

  If Reg1.Test(olMail.Body) Then

  Set M1 = Reg1.Execute(olMail.Body)
  For Each M In M1
  var = M.SubMatches(1)
  Debug.Print var & " " & i
  If i = 1 Then vtext = var
  If i = 2 Then vtext1 = var
  If i = 3 Then vtext2 = var

  Next
  End If

Next i


Debug.Print "1 " & vText & " 2 " & vText1 & " 3 " & vText2

Set Reg1 = Nothing
End Sub

After it's working, then turn it into a run a script rule.
 
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
kburrows Outlook Email Body Text Disappears/Overlaps, Folders Switch Around when You Hover, Excel Opens Randomly and Runs in the Background - Profile Corrupt? Using Outlook 0
E Copy e-mail body from outlook and insert into excel Outlook VBA and Custom Forms 3
K Importing appointment body from excel in outlook 2010 Using Outlook 1
G Retaining Tabs in outlook body Using Outlook 2
S Create Outlook Task from Template and append Body with Email Body Outlook VBA and Custom Forms 4
S New Outlook Appointment - Select All Body Text and Change Font and Size Outlook VBA and Custom Forms 1
M White square in body of Outlook Messages (O2016 Version 2012 32bit Click To Run) Using Outlook 4
A How to get body of all emails in outlook 2016 to view in blue color Using Outlook 1
L dynamic and static dates in Outlook contact "notes" ie. body Using Outlook 2
P Insert link in email body to attached document in Outlook 365 Outlook VBA and Custom Forms 0
W Space in an Outlook appointment body Using Outlook 0
J VBA Outlook : Subject line : Cut and Paste name to heading , number to very end of the body of Email Outlook VBA and Custom Forms 1
C Transfer Outlook TextBox Text Into Email Body Outlook VBA and Custom Forms 2
K ind specific Subject line from outlook and copy the content of the email body to exce Outlook VBA and Custom Forms 0
D Outlook macro with today's date in subject and paste clipboard in body Outlook VBA and Custom Forms 1
K Extract email address from body and auto-reply outlook Using Outlook 1
K Display sub-folders in body of outlook Using Outlook 1
divan Outlook 2007 - Replace email body with custom text Using Outlook 9
Vijay Kumar Tables in outlook body Outlook VBA and Custom Forms 1
J Outlook body to word document Outlook VBA and Custom Forms 11
Aussie Looking for Outlook macro to Copy Recipient Names into Email Body Outlook VBA and Custom Forms 3
R Body of email not visible in Outlook Data File Sent Folder Using Outlook 4
H Using Outlook Rules to search for NewLines in message body Using Outlook 1
S Pre populate subject + body + attachment to already open email in outlook 2007 Using Outlook 2
I Outlook Appointments - Setting default text in message body Using Outlook 3
P HTA creating Outlook MeetingItem - need formatted body text Using Outlook 4
M When I click “new message” in outlook, my cursor defaults to the body of the m Using Outlook 6
M Mail in HTML format can't be sent if url or number is in the body Outlook 2010 Using Outlook 2
L No body text in Outlook 2010 messages Using Outlook 0
S Blank body when replying with an Outlook Form. Using Outlook 21
W Recipients of Outlook messages have characters/words missing in body of message Using Outlook 6
S Clickable link on Outlook HTML Body Outlook VBA and Custom Forms 3
T How to get MailItem.Body without security warning in Outlook 2010 Outlook VBA and Custom Forms 2
T Can not change email body content on Outlook 2010 Outlook VBA and Custom Forms 2
S HELP: Create Buttons in Outlook Email body or Tool bar Outlook VBA and Custom Forms 1
A Outlook can't remember outlook.com, Exchange password. Using Outlook 0
S Related messages show in main Outlook window vice new Advanced Find windows Using Outlook 1
H Force Outlook 2019 with GMail 2-Step to Require Login? Using Outlook 0
V Setting up Outlook 2021 on new computer Using Outlook 2
G Add Map It button to Custom Contacts Form in Outlook Outlook VBA and Custom Forms 1
X Custom icon (not from Office 365) for a macro in Outlook Outlook VBA and Custom Forms 1
Victor_50 Problem - Google Workspace will stop "unsafe" access to Outlook end 2024 Using Outlook 3
C New pc, new outlook, is it possible to import auto-complete emailaddress Using Outlook 4
T Outlook 365 won't take new working password Using Outlook 0
P Can't add custom field to custom Outlook form, it always adds to the Folder instead Outlook VBA and Custom Forms 2
B Sync Outlook Public Folders to Contacts Using Outlook 2
D Delete Outlook emails from MS server Using Outlook 12
B Outlook tasks and PDF Using Outlook 4
D Outlook 2019 is no longer asking for password ... Using Outlook 5
Kika Melo How to mark as Junk any message not from Contacts (in Outlook.com) Using Outlook 3

Similar threads

Back
Top