none
Trying to use the Split function to extract Outlook email subject to Excel RRS feed

  • Question

  • This is my first time working with Macro's in outlook [VBA Newbie] - Any help would be greatly appreciated.

    I have a macro that exports Outlook emails to an Excel workbook. The only information I need to export is the subject of the email and the date the email was received. 
    I have the code below that exports the subject to my spreadsheet, but i'm not sure how to split the subject line after the first space in the subject to create two items to be placed into different cells. With the code below the whole subject goes into one cell. I tried using the split function to create an array for the subject but I get an 'error 91' with no description when running the Macro. I basically just need to split the subject after the 'case number' (which has no spaces) into two pieces of data - the case number and the comment after the case number, then have these two pieces of data go into different columns in Excel.


    All of the subject lines of these emails are formatted the same, for example:

    123-654321 APPROVED Request Approved Via John

    On my spreadsheet I need the case number to go into cell B1 and everything after the case number to go into cell D1 - the have the date in cell C1

    like so...

    [ Case # ] [ email date [ status ]
    [ XXX-XXXXX ] [ 1-1-2013 ] [ CONTINGENT Request made Via John ]
    [ XXX-XXXXX ] [ 1-2-2013 ] [ APPROVED Request Approved Via John ]
    [ XXX-XXXXX ] [ 1-3-2013 ] [ Denied Request Denied Via John ]
    [ XXX-XXXXX ] [ 1-4-2013 ] [ OtherStatus Message Request status Via John ]



    This works, but puts the subject into one column in Excel:


     
    Sub ExportToExcel()
      On Error GoTo ErrHandler
      Dim appExcel As Excel.Application
      Dim wkb As Excel.Workbook

    Dim wks As Excel.Worksheet

    Dim rng As Excel.Range

    Dim strSheet As String

    Dim strPath As String

    Dim intRowCounter As Integer

    Dim intColumnCounter As Integer

    Dim msg As Outlook.MailItem

    Dim nms As Outlook.NameSpace

    Dim fld As Outlook.MAPIFolder

    Dim itm As Object
        strSheet = "MyWorkbook.xlsx"
        strPath = "C:\Path2MyWorkbook\"

    strSheet = strPath & strSheet



    Debug.Print strSheet
      'Select export folder
    Set nms = Application.GetNamespace("MAPI")

    Set fld = nms.PickFolder
      'Handle potential errors with Select Folder dialog box.
    If fld Is Nothing Then

    MsgBox "There are no mail messages to export", vbOKOnly, "Error"

    Exit Sub

    ElseIf fld.DefaultItemType <> olMailItem Then

    MsgBox "There are no mail messages to export", vbOKOnly, "Error"

    Exit Sub

    ElseIf fld.Items.Count = 0 Then

    MsgBox "There are no mail messages to export", vbOKOnly, "Error"

    Exit Sub

    End If
      'Open and activate Excel workbook.
    Set appExcel = CreateObject("Excel.Application")

    appExcel.Workbooks.Open (strSheet)

    Set wkb = appExcel.ActiveWorkbook

    Set wks = wkb.Sheets(1)

    wks.Activate

    appExcel.Application.Visible = True
      'Copy field items in mail folder.
    For Each itm In fld.Items

    intColumnCounter = 1

    Set msg = itm

    intRowCounter = intRowCounter + 3

    intColumnCounter = intColumnCounter + 1

    Set rng = wks.Cells(intRowCounter, intColumnCounter)

    rng.Value = msg.Subject

    intColumnCounter = intColumnCounter + 1

    Set rng = wks.Cells(intRowCounter, intColumnCounter)

    rng.Value = msg.SentOn


    Next itm
      Set appExcel = Nothing
      Set wkb = Nothing

    Set wks = Nothing

    Set rng = Nothing

    Set msg = Nothing

    Set nms = Nothing

    Set fld = Nothing

    Set itm = Nothing
      Exit Sub
    ErrHandler:  If Err.Number = 1004 Then

    MsgBox strSheet & " doesn't exist", vbOKOnly, "Error"

    Else

    MsgBox Err.Number & "; Description: ", vbOKOnly, "Error"

    End If

    Set appExcel = Nothing

    Set wkb = Nothing

    Set wks = Nothing

    Set rng = Nothing

    Set msg = Nothing

    Set nms = Nothing

    Set fld = Nothing

    Set itm = Nothing
    End Sub


    I tried this to split the subject:


     
    Sub Export2Excel()
      On Error GoTo ErrHandler
      Dim appExcel As Excel.Application
      Dim wkb As Excel.Workbook

    Dim wks As Excel.Worksheet

    Dim rng As Excel.Range

    Dim strSheet As String

    Dim strPath As String

    Dim intRowCounter As Integer

    Dim intColumnCounter As Integer

    Dim msg As Outlook.MailItem

    Dim nms As Outlook.NameSpace

    Dim fld As Outlook.MAPIFolder

    ' Split Subject at first Space - Create array with Subject1 and Subject2  -- 

    Dim msgInfo As  msg.Subject

    Dim varSplit As Variant
    varSplit = Split(msgInfo, " ")

    strSubject1 = varSplit(0)
    strSubject2 = varSplit(9)

    ' End of Split Array

    Dim itm As Object
        strSheet = "MyWorkbook.xlsx"
        strPath = "C:\Path2MyWorkbook\"

    strSheet = strPath & strSheet



    Debug.Print strSheet
      'Select export folder
    Set nms = Application.GetNamespace("MAPI")

    Set fld = nms.PickFolder
      'Handle potential errors with Select Folder dialog box.
    If fld Is Nothing Then

    MsgBox "There are no mail messages to export", vbOKOnly, "Error"

    Exit Sub

    ElseIf fld.DefaultItemType <> olMailItem Then

    MsgBox "There are no mail messages to export", vbOKOnly, "Error"

    Exit Sub

    ElseIf fld.Items.Count = 0 Then

    MsgBox "There are no mail messages to export", vbOKOnly, "Error"

    Exit Sub

    End If
      'Open and activate Excel workbook.
    Set appExcel = CreateObject("Excel.Application")

    appExcel.Workbooks.Open (strSheet)

    Set wkb = appExcel.ActiveWorkbook

    Set wks = wkb.Sheets(1)

    wks.Activate

    appExcel.Application.Visible = True
      'Copy field items in mail folder.
    For Each itm In fld.Items

    intColumnCounter = 1

    Set msg = itm

    intRowCounter = intRowCounter + 3

    'msgInfo Array - strSubject1
    intColumnCounter = intColumnCounter + 1

    Set rng = wks.Cells(intRowCounter, intColumnCounter)

    rng.Value = strSubject1

    intColumnCounter = intColumnCounter + 1

    Set rng = wks.Cells(intRowCounter, intColumnCounter)

    rng.Value = msg.SentOn

    'msgInfo  Array - strSubject2
    intColumnCounter = intColumnCounter + 1

    Set rng = wks.Cells(intRowCounter, intColumnCounter)

    rng.Value = strSubject2


    Next itm
      Set appExcel = Nothing
      Set wkb = Nothing

    Set wks = Nothing

    Set rng = Nothing

    Set msg = Nothing

    Set nms = Nothing

    Set fld = Nothing

    Set itm = Nothing
      Exit Sub
    ErrHandler:  If Err.Number = 1004 Then

    MsgBox strSheet & " doesn't exist", vbOKOnly, "Error"

    Else

    MsgBox Err.Number & "; Description: ", vbOKOnly, "Error"

    End If

    Set appExcel = Nothing

    Set wkb = Nothing

    Set wks = Nothing

    Set rng = Nothing

    Set msg = Nothing

    Set nms = Nothing

    Set fld = Nothing

    Set itm = Nothing
    End Sub

    • Edited by javabeans99 Wednesday, March 6, 2013 12:03 AM
    Tuesday, March 5, 2013 12:35 AM

Answers

  • To get the macro to add the data to the next row of the worksheet, you need to establish which is the next available row each time you add data via the loop.  e.g.

    NextRow = xlSheet.Range("B" & wks.Rows.Count).End(-4162).Row + 1


    Graham Mayor - Word MVP
    www.gmayor.com

    • Proposed as answer by Shasur Sunday, April 28, 2013 6:03 AM
    • Marked as answer by Damon ZhengModerator Monday, July 1, 2013 1:43 PM
    Thursday, April 25, 2013 5:34 AM
  • If you want all the rest of string then you will have to loop through  the array and reassemble it

    e.g.

    For i = 1 to varSplit(UBound(varSplit))

          strString2 = varSplit(i)

          If i < varSplit(UBound(varSplit)) then strString2 = strString2 & chr(32)

    Next i


    Graham Mayor - Word MVP
    www.gmayor.com

    • Proposed as answer by Shasur Sunday, April 28, 2013 6:03 AM
    • Marked as answer by Damon ZhengModerator Monday, July 1, 2013 1:43 PM
    Wednesday, March 6, 2013 5:39 AM

All replies

  • There is never going to be a varSplit(9) in the string? If you want the last item 'John' the syntax would be

    varSplit(UBound(varSplit))



    Graham Mayor - Word MVP
    www.gmayor.com

    Tuesday, March 5, 2013 8:15 AM
  • Thanks for the response.

    I need to get the first string of text from the subject line, which is a number formatted as 111-222222 into a single cell in Excel; Everything after the number I need in a separate cell.

    I got the Idea of the varSplit(9) from here: http://stackoverflow.com/questions/9460240/how-do-i-split-a-string-only-after-the-first-instance-of-the-delimiter 

    Wednesday, March 6, 2013 12:13 AM
  • If you want all the rest of string then you will have to loop through  the array and reassemble it

    e.g.

    For i = 1 to varSplit(UBound(varSplit))

          strString2 = varSplit(i)

          If i < varSplit(UBound(varSplit)) then strString2 = strString2 & chr(32)

    Next i


    Graham Mayor - Word MVP
    www.gmayor.com

    • Proposed as answer by Shasur Sunday, April 28, 2013 6:03 AM
    • Marked as answer by Damon ZhengModerator Monday, July 1, 2013 1:43 PM
    Wednesday, March 6, 2013 5:39 AM
  • I'll give that a try here in a few minutes.

    Thanks! I appreciate your help.

    Wednesday, March 6, 2013 7:43 PM
  • I got this working by using the 'SPLIT' function to split the subject into two variables using the space as the delimeter. Your suggestion for using the array to split the subject line was very helpful and put me on the right track - THANKS

    For Each itm In fld.Items
        intColumnCounter = 1
        Set msg = itm
        Dim eSub() As String
        eSub = Split(msg.Subject, " ", 2)
    

    A couple of questions though, The code below works.... sort of. It pulls the subject line from the email and splits the subject into two variables 'eSub(0)' and 'eSub(1)' and exports the data into the correct columns. The problem is that it does not append the data to the spreadsheet. I need to run this macro periodically throughout the day to append this information to a shared spreadsheet. When I run the code below it overwrites the data in my spreadsheet. How would i make the new data append to the spreadsheet, preferably to the top?

    Also, on my spreadsheat I have the first column as the header fields , case# / Date / Status. to get the data to not overwrite these fields i have to use intRowCounter = intRowCounter + 2, but this puts puts my data on every other row of the spreadsheet as well. Is there a way around this? If not I can deal with having the data on every other row of the spreadsheet.

    Also, would it be better or more efficient to use C# code for this?  I just finished a C# class in college and am currently taking C# ASP.NET MVC4.

    '
    '   SpreadsheetItemsExport
    '
    '   Extracts subject  |  Splits Subject after case number  |  extracts date  |  '' should append to spreadsheet ''
    '
    
    Sub ExportToExcel()
    
        On Error GoTo ErrHandler
    
        Dim appExcel As Excel.Application
        Dim wkb As Excel.Workbook
        Dim wks As Excel.Worksheet
        Dim rng As Excel.Range
        Dim strSheet As String
        Dim strPath As String
        Dim intRowCounter As Integer
        Dim intColumnCounter As Integer
        Dim msg As Outlook.MailItem
        Dim nms As Outlook.NameSpace
        Dim fld As Outlook.MAPIFolder
        Dim itm As Object
        
        ' Define Excel Workbook and Path
        strSheet = "MySpreadsheet.xlsx"
        strPath = "C:\foler\subfolder\"
        strSheet = strPath & strSheet
    
        Debug.Print strSheet
        
        'Select Outlook folder to export from
        Set nms = Application.GetNamespace("MAPI")
        Set fld = nms.PickFolder
        'Set fld = Set fld = myNamespace.GetDefaultFolder(olFolderInbox).Folders("SpreadsheetItems")
      
      ' Error Handler for potential errors with Select Folder dialog box - " Set fld = nms.PickFolder "
        If fld Is Nothing Then
            MsgBox "There are no mail messages to export", vbOKOnly, "Error"
            Exit Sub
        ElseIf fld.DefaultItemType <> olMailItem Then
            MsgBox "There are no mail messages to export", vbOKOnly, "Error"
            Exit Sub
        ElseIf fld.Items.Count = 0 Then
            MsgBox "There are no mail messages to export", vbOKOnly, "Error"
            Exit Sub
        End If
       
    
       'Open and activate Excel workbook.
        Set appExcel = CreateObject("Excel.Application")
        appExcel.Workbooks.Open (strSheet)
        Set wkb = appExcel.ActiveWorkbook
        Set wks = wkb.Sheets(1)
        wks.Activate
        appExcel.Application.Visible = True
       
    
       'Copy field items in mail folder then declare array to split the subject line at the first 'space' ; creates two variables words(0) and words(1)
    For Each itm In fld.Items
        intColumnCounter = 1
        Set msg = itm
        Dim eSub() As String
        eSub = Split(msg.Subject, " ", 2)
        
    
        intRowCounter = intRowCounter + 3
    
        ' Case Number - Col B
        intColumnCounter = intColumnCounter + 1
        Set rng = wks.Cells(intRowCounter, intColumnCounter)
        rng.Value = eSub(0)
        
        ' Date Sent - Col C
        intColumnCounter = intColumnCounter + 1
        Set rng = wks.Cells(intRowCounter, intColumnCounter)
        rng.Value = msg.SentOn
    
        ' Status - Col D
        intColumnCounter = intColumnCounter + 1
        Set rng = wks.Cells(intRowCounter, intColumnCounter)
        rng.Value = eSub(1)
    
    
    
    
    Next itm
    
        Set appExcel = Nothing
        Set wkb = Nothing
        Set wks = Nothing
        Set rng = Nothing
        Set msg = Nothing
        Set nms = Nothing
        Set fld = Nothing
        Set itm = Nothing
        Exit Sub
    
    ErrHandler:     If Err.Number = 1004 Then
            MsgBox strSheet & " doesn't exist", vbOKOnly, "Error"
        Else
            MsgBox Err.Number & "; Description: ", vbOKOnly, "Error"
        End If
    
        Set appExcel = Nothing
        Set wkb = Nothing
        Set wks = Nothing
        Set rng = Nothing
        Set msg = Nothing
        Set nms = Nothing
        Set fld = Nothing
        Set itm = Nothing
        End Sub
    

    Wednesday, April 24, 2013 11:36 PM
  • To get the macro to add the data to the next row of the worksheet, you need to establish which is the next available row each time you add data via the loop.  e.g.

    NextRow = xlSheet.Range("B" & wks.Rows.Count).End(-4162).Row + 1


    Graham Mayor - Word MVP
    www.gmayor.com

    • Proposed as answer by Shasur Sunday, April 28, 2013 6:03 AM
    • Marked as answer by Damon ZhengModerator Monday, July 1, 2013 1:43 PM
    Thursday, April 25, 2013 5:34 AM
  • I ended up using 'intRowCounter' and setting it to a variable, LastUsedRow' that is calculated by going through the rows in column C (which always has data) then adding 1, This allows for data to be inputted into the next free row.

        LastUsedRow = Range("C" & Rows.Count).End(xlUp).Row
        intRowCounter = LastUsedRow + 1

    Monday, July 1, 2013 6:09 PM
  • That is essentially what I proposed, albeit using column C rather than B, but if some columns may have empty cells you could use

    NextRow = xlSheet.UsedRange.Rows.Count + 1


    Graham Mayor - Word MVP
    www.gmayor.com

    Tuesday, July 2, 2013 4:27 AM
  • Yes, your answer solved the issue I was working with. I was just posting the variation of what I used and writing out the steps (sorta for myself to better understand what the process was).

    Appreciate your help!  Thanks!

    NextRow = xlSheet.UsedRange.Rows.Count + 1  --- That's good to know.

    Tuesday, July 2, 2013 2:43 PM