Announcement

Collapse
No announcement yet.

Need help adjusting VBA Code outlook email to excel

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Need help adjusting VBA Code outlook email to excel



    I've tried googling a few things.

    I'm an absolute n00b at VBA...

    I want to get an email form which is formatted like:

    Form Submission:
    Select place:
    EXAM
    First name:
    John
    Last name:
    Doe
    Phone Number:
    07555555555
    Email:
    j[email protected]
    Query String:
    from all emails in a specific folder in outlook to an excel sheet.

    I have tried adjusting someone elses code however I'm not doing great with the code and delimiters. It creates the headings and then puts the whole message in the first column.

    Code:
    Sub Extract()
        On Error Resume Next
        Set myOlApp = Outlook.Application
        Set mynamespace = myOlApp.GetNamespace("mapi")
    
        
    
        Set myfolder = myOlApp.ActiveExplorer.CurrentFolder
        Set xlobj = CreateObject("excel.application")
        xlobj.Visible = True
        xlobj.Workbooks.Add
        'Set Heading
    
        xlobj.Range("a" & 1).Value = "Place"
        xlobj.Range("b" & 1).Value = "First"
        xlobj.Range("c" & 1).Value = "Last"
        xlobj.Range("d" & 1).Value = "Phone"
        xlobj.Range("e" & 1).Value = "Email"
    
    
        For I = 1 To myfolder.Items.Count
        Set myitem = myfolder.Items(I)
        msgtext = myitem.Body
    
        'search for specific text
        delimtedMessage = Replace(delimitedMessage, "Select place:", "$")   
        delimtedMessage = Replace(delimitedMessage, "First name:", "$")
        delimtedMessage = Replace(delimitedMessage, "Last name:", "$")
        delimitedMessage = Replace(delimitedMessage, "Phone number:", "#")
        delimitedMessage = Replace(msgtext, "Email:", "$")
        messageArray = Split(delimtedMessage, "$")
        'write to excel
        xlobj.Range("a" & I + 1).Value = messageArray(0)
        xlobj.Range("b" & I + 1).Value = messageArray(1)
        xlobj.Range("c" & I + 1).Value = messageArray(2)
        xlobj.Range("d" & I + 1).Value = messageArray(3)
        xlobj.Range("e" & I + 1).Value = messageArray(4)
    
        Next
        End Sub

    Any help is much appreciated.
Working...
X