none
Export digits from Outlook email body to Excel worksheet RRS feed

  • Question

  • Hey, I need help with a VBA script which i can use in an Outlook Rule to export a sequence of digits like "12345678910" from an Outlook email body and write it to an Excel worksheet (The only digits in the email body is the sequence).

    I'm having trouble finding the right resources to do it myself, a lot of the examples are over complicating it for me.

    Any help is greatly appreciated,

    Friday, September 5, 2014 1:30 PM

Answers

  • Try something like this - see if it returns the digits of interest, and then we'll go from there

          

      Sub Test()

     Dim strBody As String
        Dim X As Long

        Set olItem = Application.ActiveExplorer().Selection(1)
        strBody = olItem.Body

       For X = 1 To Len(strBody)
         If Mid(strBody, X, 1) Like "[!0-9]" Then Mid(strBody, X) = "@"
       Next X
       strBody = Application.Trim(Replace(strBody, "@", ""))

       MsgBox strBody

    End Sub

    Friday, September 5, 2014 4:26 PM

All replies

  • Try something like this - see if it returns the digits of interest, and then we'll go from there

          

      Sub Test()

     Dim strBody As String
        Dim X As Long

        Set olItem = Application.ActiveExplorer().Selection(1)
        strBody = olItem.Body

       For X = 1 To Len(strBody)
         If Mid(strBody, X, 1) Like "[!0-9]" Then Mid(strBody, X) = "@"
       Next X
       strBody = Application.Trim(Replace(strBody, "@", ""))

       MsgBox strBody

    End Sub

    Friday, September 5, 2014 4:26 PM
  • This code returns:

    Run-time error '438':

    Object doesn't support this property or method.

    I think its missing references to the outlook application but I'm not sure, I'm a newbie with VBA.. Any idea how to get this code to run?

    Friday, September 5, 2014 5:07 PM
  • If you are running it in Outlook:

    " VBA script which i can use in an Outlook Rule"

    then you don't need a reference to Outlook. You need to have the code within Outlook.

    If you want to use Excel to open and read from an outlook message, that is a different problem.

    Friday, September 5, 2014 6:59 PM
  • Running the code from Outlook, pressing Alt+F11 to bring up the VBA IDE...
    Friday, September 5, 2014 7:07 PM
  • What line is it giving you an error on?
    Friday, September 5, 2014 7:43 PM
  • I dont see which line is giving the error, it doesnt say...
    Monday, September 8, 2014 1:31 PM
  • Try this slightly modified version and make sure you have the message you wish to test selected..

    Sub Test()
    Dim olItem As Outlook.MailItem
    Dim strBody As String
    Dim X As Long
        Set olItem = ActiveExplorer.Selection(1)
        strBody = olItem.Body
        For X = 1 To Len(strBody)
            If Mid(strBody, X, 1) Like "[!0-9]" Then Mid(strBody, X) = "@"
        Next X
        strBody = Trim(Replace(strBody, "@", ""))
        MsgBox strBody
    End Sub


    Graham Mayor - Word MVP
    www.gmayor.com


    Monday, September 8, 2014 1:42 PM
  • That worked!

    Now i just need to write the number to A1 in an excel file, but the code i've added returns "Error 13 Type Mismatch" I'm slowing starting to understand the syntax but im still stuck:

    Sub Test()
        Dim olItem As Outlook.MailItem
        Dim strBody As String
        Dim X As Long
        
        Set olItem = ActiveExplorer.Selection(1)
        strBody = olItem.Body
        For X = 1 To Len(strBody)
            If Mid(strBody, X, 1) Like "[!0-9]" Then Mid(strBody, X) = "@"
        Next X
        strBody = Trim(Replace(strBody, "@", ""))
        
        '~~> Output to MsgBox
        'MsgBox strBody
        
        '~~> Establish an EXCEL application object
        On Error Resume Next
        Set oXLApp = GetObject(, "Excel.Application")

        '~~> If not found then create new instance
        If Err.Number <> 0 Then
            Set oXLApp = CreateObject("Excel.Application")
        End If
        Err.Clear
        On Error GoTo 0

        '~~> Show Excel
        oXLApp.Visible = True

        '~~> Open the relevant file
        Set oXLwb = oXLApp.Workbooks.Open("C:\test.xlsx")

        '~~> Set the relevant output sheet. Change as applicable
        Set oXLws = oXLwb.Sheets("Sheet1")
        
        oXLws.Cells("A", 1).Value = strBody
        
        oXLws.Save
        oXLws.Close
            
    End Sub

    Monday, September 8, 2014 4:01 PM
  • Cells takes Row, Column, so try changing

    oXLws.Cells("A", 1).Value = strBody

    to

    oXLws.Cells(1,"A").Value = strBody

    Monday, September 8, 2014 4:13 PM
  • That worked! :P

    The digits are being placed in the A1 cell as expected, however i get this error/warning: "Run-time error '438': Object doesn't support this property or method"

    Also the "save and quit" bit in the end doesn't seem to be working, could be blocked by the runtime error.. i dont know..

    So the code is now:

    Sub Test()
        Dim olItem As Outlook.MailItem
        Dim strBody As String
        Dim X As Long
        
        Set olItem = ActiveExplorer.Selection(1)
        strBody = olItem.Body
        For X = 1 To Len(strBody)
            If Mid(strBody, X, 1) Like "[!0-9]" Then Mid(strBody, X) = "@"
        Next X
        strBody = Trim(Replace(strBody, "@", ""))
        
        On Error Resume Next
        Set oXLApp = GetObject(, "Excel.Application")
        If Err.Number <> 0 Then
            Set oXLApp = CreateObject("Excel.Application")
        End If
        Err.Clear
        On Error GoTo 0

        oXLApp.Visible = True
        Set oXLwb = oXLApp.Workbooks.Open("C:\test.xlsx")
        Set oXLws = oXLwb.Sheets("Sheet1")
        
        oXLws.Cells(1, "A").Value = strBody
        
        oXLws.Save
        oXLws.Close
            
    End Sub

    Monday, September 8, 2014 5:51 PM
  • Sorry, I did not notice - you are trying to save the sheet, not the workbook. Change

        oXLws.Save
        oXLws.Close 

    to

        oXLwb.Save

        oXLwb.Close

    Monday, September 8, 2014 6:01 PM
  • also I can can recommend you a free addin.

    CodeTwo Outlook Export

    CodeTwo Outlook Export

    You can export selected or all data from active folder to csv file.

    Excel open it correctly.


    Oskar Shon, Office System MVP - www.VBATools.pl
    if Helpful; Answer when a problem solved

    Tuesday, September 9, 2014 7:02 AM
    Answerer
  • If you now want to run it from a rule you will need to change the sub to reference the INCOMING message e.g. replace

    Sub Test()
        Dim olItem As Outlook.MailItem
        Dim strBody As String
        Dim X As Long
        
        Set olItem = ActiveExplorer.Selection(1)

    with

    Sub Test(olItem as Outlook.MailItem)
        Dim strBody As String
        Dim X As Long
          



    Graham Mayor - Word MVP
    www.gmayor.com

    Tuesday, September 9, 2014 12:24 PM
  • Thank you so much for your help guys! You are awesome!

    This is the final version of the code for anyone who may find it useful:

    Sub Test()
        Dim olItem As Outlook.MailItem
        Dim strBody As String
        Dim X As Long
        
        Set olItem = ActiveExplorer.Selection(1)
        strBody = olItem.Body
        For X = 1 To Len(strBody)
            If Mid(strBody, X, 1) Like "[!0-9]" Then Mid(strBody, X) = "@"
        Next X
        strBody = Trim(Replace(strBody, "@", ""))
        
        On Error Resume Next
        Set oXLApp = GetObject(, "Excel.Application")
        If Err.Number <> 0 Then
            Set oXLApp = CreateObject("Excel.Application")
        End If
        Err.Clear
        On Error GoTo 0

        oXLApp.Visible = True
        Set oXLwb = oXLApp.Workbooks.Open("C:\test.xlsx")
        Set oXLws = oXLwb.Sheets("Sheet1")
        
        oXLws.Cells(1, "A").Value = strBody
        
        oXLwb.Save
        oXLwb.Close
        oXLApp.Application.Quit
    End Sub

    Cheers!!!


    • Edited by Alandroid Wednesday, September 10, 2014 2:33 PM Information Leak
    Wednesday, September 10, 2014 2:33 PM
  • I had to make the following change at the top of the script (To make the script run from a Rule):

    Public Sub Test(olItem As Outlook.MailItem)
        'Dim olItem As Outlook.MailItem

    However now the result is it is parsing all the emails in my folder instead of just the latest recieved one. Whats going on? I'm assuming this line is incorrect:

    Set olItem = ActiveExplorer.Selection(1)

    Thursday, September 11, 2014 8:13 PM
  • I quoted the required changes required to make it work from a rule in my last message? Remove the bold lines in the first example and add the bold text in the second.

    Graham Mayor - Word MVP
    www.gmayor.com

    Friday, September 12, 2014 4:49 AM