使用Outlook VB从电子邮件正文中获取第一行文本

时间:2018-04-24 21:15:35

标签: html vba email outlook outlook-vba

我从某个地方偷了一个函数,允许我从剪贴板中取出HTML并放入Outlook 2013电子邮件。

这很好用,但我还想修改它以从电子邮件正文中获取第一行文本并将其用作主题行。

这样一切都可以包含在HTML中。但是我几乎没有使用VB的经验,在网上花了一些时间查看API和文档之后我仍然无法弄明白。这是我到目前为止所拥有的。

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

重申一下,我想删除格式化后的电子邮件正文的第一行,并将其用作主题行。

2 个答案:

答案 0 :(得分:0)

这很快又脏,在这里和那里抓住几分钟来建造,但这样的事情应该让你开始:



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 = "someone@domain.com"
      .Subject = strLine
      .BodyFormat = olFormatHTML ' olFormatPlain == send plain text message
      .HTMLBody = cText + email.HTMLBody
     
      .Display
    End With
    
    Set email = Nothing
    Set cBoard = Nothing

End Sub




答案 1 :(得分:0)

我做了更多研究并阅读了API。最后我想出来了。我的解决方案发布在下面。感谢其他评论者提供的所有帮助。

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