VBA to parse email body text not looping

csquared013

New member
Joined
Nov 13, 2020
Messages
2
Reaction score
0
Points
0
Location
Santa Fe
Excel Version(s)
2010
Hello all,

I was wondering if a generous soul would be able to scan over my code and show me where I went. I'm new to VBA and this turned out to be a heavier lift than expected, even when adapting other people's code to my own purposes.
My goal is to parse email body text information into individual cells for each email in a specific inbox. Luckily, the emails come through with the data I need in a consistent format delimited by colons, and with each data point on a different line in the received emails.

The largest issue I am having is that I can't seem to get the code to loop through all the emails in the box. My smaller issue is that "tournament time selection" isn't populating in excel, and "stream link" is only populating up to "HTTPS" since there's a colon in the web address and I'm telling VBA to delimit by Colons. I'm sure there's a way around this but after hours of research, I've yet to find it. The struggles of learning a new language I suppose :frusty:

The body of my emails come through consistently in the format pasted below:

NUMBER OF ENTRANTS: XXX
TOUNAMENT TIME SELECTION: 7-10P EST
BRACKET SELECT: XXX
TEAM NAME: XXX
STREAM LINK: https://twitch.tv/XXX
PLAYER 1 (ACTIVISION USERNAME #): XXX
PLAYER 2 (ACTIVISION USERNAME #): XXX
PLAYER 3 (ACTIVISION USERNAME #): XXX
PLAYER 4 (ACTIVISION USERNAME #): XXX


As of right now the VBA works for one single email, and populates successfully into excel by dropping data below where I have assigned cell names corresponding to the VBA code.


Below, is the current VBA I have struggled to cobble together:

Code:
Sub Extract()          
    
Dim outlookapp As outlook.Application
Dim outlooknamespace As Namespace
Dim folder As MAPIFolder
Dim outlookmail As Variant
Dim i As Integer
   
Set outlookapp = New outlook.Application
Set outlooknamespace = outlookapp.GetNamespace("MAPI")
Set folder = outlooknamespace.GetDefaultFolder(olFolderInbox).Folders("Registrations")
    
    i = 1
    
    For Each outlookmail In folder.Items            


        Dim X10BJ As Worksheet
        Dim msgtext As String
        Dim msgline() As String
        Dim messagearray() As String
        Dim MyValue As String
        
        Set xlobj = Sheets("sheet1")
    
        msgtext = outlookmail.Body
        messagearray = split(msgtext, vbCrLf)
            
        i = 1
        
        For j = 0 To UBound(messagearray)


        msgline = split(messagearray(j) & ":", ":")
            
            Select Case Left(msgline(0), 8)         
                
                Case "NUMBER O"                     
                    Range("Number_of_Entrants").Offset(i, 0).Value = Trim(msgline(1))


                Case "TOURNAME"
                    Range("Tournament_Time_Selection").Offset(i, 0).Value = Trim(msgline(1))
                    
                Case "BRACKET "
                    Range("Bracket_Select").Offset(i, 0).Value = Trim(msgline(1))
                    
                Case "TEAM NAM"
                    Range("Team_Name1").Offset(i, 0).Value = Trim(msgline(1))
                    
                Case "STREAM L"
                    Range("Stream_Link1").Offset(i, 0).Value = Trim(msgline(1))
                    
                Case "PLAYER 1"
                    Range("Activision_Name_1").Offset(i, 0).Value = Trim(msgline(1))
                    
                Case "PLAYER 2"
                    Range("Activision_Name_2").Offset(i, 0).Value = Trim(msgline(1))
                    
                Case "PLAYER 3"
                    Range("Activision_Name_3").Offset(i, 0).Value = Trim(msgline(1))
                    
                Case "PLAYER 4"
                    Range("Activision_Name_4").Offset(i, 0).Value = Trim(msgline(1))
                    
          i = i + 1
          
          End Select
          
          Next
        
    Next outlookmail       
                            
Set folder = Nothing
Set outlooknamespace = Nothing
Set outlookapp = Nothing
          
End Sub


Any advice on correcting my looping issue or getting my two missing fields to populate would be immensely appreciated. I'm trying to avoid paying a hefty sum for a parsing service for a small business a couple close friends and I are trying to get off the ground. Further, advice on how I may be able to accomplish this more cleanly would also be appreciated. I'm sure since this is excel, there has to be more than one way to deal with this task efficiently.

Let me know if there is anything at all I can explain further/more clearly, or if there is additional information I can provide to help you help me.
 
Last edited by a moderator:
Back
Top