CODEWITHSUNDEEP
htmlvbaemailoutlook
Prgrm.celeritas
Prgrm.celeritas

Reputation: 321

Get the first line of text from email body with Outlook VB

I stole a function from somewhere online that allows me to take HTML from my clipboard and put in an Outlook 2013 email.

This works fine, but I would also like to modify it to grab the first line of text from the email body and use that as the subject line.

That way everything can be included in the HTML. However I have almost no experience with VB and after spending some time online look at API's and documentation I am still not able to figure it out. Here is what I have so far. 

Sub PrependClipboardHTML()
    Dim email As Outlook.MailItem
    Dim cBoard As DataObject
    Dim lines() As String

    Set email = Application.ActiveInspector.CurrentItem
    Set cBoard = New DataObject

    cBoard.GetFromClipboard

    email.HTMLBody = cBoard.GetText + email.HTMLBody
    lines = Split(email.Body, vbNewLine)
    ' this does not produce anything
    email.subject = lines(0)

    'remove first line of email

    Set cBoard = Nothing
    Set email = Nothing

End Sub

To reiterate, I want to remove the first line of the post-formatted email body and use it as the subject line.

Upvotes: 1

Views: 2611

Answers (2)

Prgrm.celeritas
Prgrm.celeritas

Reputation: 321

I did some more research and read over the API's. In the end I figured it out. My solution is posted below. Thanks for all the help from the other commenters.

Sub PrependClipboardHTML()
   Dim email As Outlook.MailItem
   Dim cBoard As DataObject

   Set email = Application.ActiveInspector.CurrentItem
   Set cBoard = New DataObject

   cBoard.GetFromClipboard

   Dim sText As String
   Dim headerStart As Integer
   Dim headerEnd As Integer
   Dim HTMLPre As String
   Dim HTMLPost As String
   Dim subject As String
   Const headerStartLen = 20
   Const headerEndStr = "</h2>"

   sText = cBoard.GetText
   headerStart = InStr(sText, "<h2 id=")

   If headerStart > 0 Then
       headerEnd = InStr(headerStart, sText, headerEndStr)
       If headerEnd > 0 Then
           subject = Mid(sText, _
               headerStart + headerStartLen, _
               headerEnd - headerStart - headerStartLen)
           HTMLPre = Mid(sText, 1, headerStart - 1)
           HTMLPost = Mid(sText, headerEnd + Len(headerEndStr))
       End If
   End If

   email.HTMLBody = HTMLPre + HTMLPost + email.HTMLBody
   If Len(email.subject) = 0 Then
       email.subject = subject
   End If

   Set cBoard = Nothing
   Set email = Nothing

End Sub

Upvotes: 0

cssyphus
cssyphus

Reputation: 40106

This is quick and dirty, grabbing a few mins here and there to construct, but something like this should get you started:

Public Sub PrependClipboardToHTML()
    Dim email As Outlook.MailItem
    Dim cBoard As DataObject
    Dim cText, strLine As String
    Dim strArray() As String
    
    Set email = Application.CreateItem(olMailItem)
    Set cBoard = New DataObject
    cBoard.GetFromClipboard
    cText = cBoard.GetText
    strArray = Split(cText, vbCrLf)
    strLine = CStr(strArray(0))
    
     With email
      .To = "[email protected]"
      .Subject = strLine
      .BodyFormat = olFormatHTML ' olFormatPlain == send plain text message
      .HTMLBody = cText + email.HTMLBody
     
      .Display
    End With
    
    Set email = Nothing
    Set cBoard = Nothing

End Sub

Upvotes: 1

Related Questions