將從網站復制的表格粘貼到 Outlook Email 的正文中使用 VBA

Question

我有創建 email 的代碼，填寫收件人、抄送、主題字段； 我希望它向我從 Inte.net 手動復制的表格發送文本。 所以基本上我希望它在 email 的正文中執行 ctrl-v。我嘗試了 doclipboard.GetText 方法和其他一些方法。 這是最近的嘗試。

Sub SendEmail(ByVal strSubject As String, ByVal strBody As String, ByVal blnDisplay As Boolean, ByVal blnAddPaste As Boolean)

    Dim bStarted As Boolean
    Dim oOutlookApp As Outlook.Application
    Dim oItem As Outlook.MailItem

    On Error Resume Next

    'Get Outlook if it's running
    Set oOutlookApp = GetObject(, "Outlook.Application")
    If Err <> 0 Then
        'Outlook wasn't running, start it from code
        Set oOutlookApp = CreateObject("Outlook.Application")
        bStarted = True
    End If

    'Create a new mailitem
    Set oItem = oOutlookApp.CreateItem(olMailItem)

    With oItem
        'Set the recipient for the new email
        .To = "Email Addresses"
        'Set the recipient for a copy
        '.CC = strCC
        'Set the subject
        .Subject = "Salesforce " & EmailDateFormat & " " & strSubject
        'The content of the document is used as the body for the email
        If blnAddPaste Then
            .HTMLBody = strBody & "<br><br>" & _ 
              Selection.PasteAndFormat(Word.WdRecoveryType.wdTableOriginalFormatting) ' this is what I need to fix
        Else
            .HTMLBody = strBody
        End If
        
        
        If blnDisplay Then
            .Display
        Else
            .Send
        End If
    End With

    If bStarted Then
        'If we started Outlook from code, then close it
        oOutlookApp.Quit
    End If

    'Clean up
    Set oItem = Nothing
    Set oOutlookApp = Nothing

End Sub

我如何獲得一張表格以粘貼到 outlook email 中？

Answer 1

我為其他正在尋找解決方案的人解決了這個問題。

Sub SendEmail(ByVal strSubject As String, ByVal strBody As String, ByVal blnDisplay As Boolean, ByVal blnAddPaste As Boolean)

    Dim bStarted As Boolean
    Dim oOutlookApp As Outlook.Application
    Dim oItem As Outlook.MailItem
    Dim oWordDoc As Word.Document
    Dim oWordRange As Word.Range
    Dim VarPosition As Variant

    On Error Resume Next

    'Get Outlook if it's running
    Set oOutlookApp = GetObject(, "Outlook.Application")
    If Err <> 0 Then
        'Outlook wasn't running, start it from code
        Set oOutlookApp = CreateObject("Outlook.Application")
        bStarted = True
    End If

    'Create a new mailitem
    Set oItem = oOutlookApp.CreateItem(olMailItem)

    With oItem
        If blnDisplay Then
            .Display
        End If
        Set oWordDoc = oItem.GetInspector.WordEditor
        'Set the recipient for the new email
        .To = "Email Addresses"
        'Set the recipient for a copy
        '.CC = strCC
        'Set the subject
        .Subject = "Salesforce " & EmailDateFormat & " " & strSubject
        'The content of the document is used as the body for the email
        If blnAddPaste Then
            .Body = strBody  '& Selection.PasteAndFormat(Word.WdRecoveryType.wdTableOriginalFormatting)
            VarPosition = oWordDoc.Range.End - 1
            Set oWordRange = oWordDoc.Range(VarPosition, VarPosition)
            oWordRange.Select
            oWordRange.PasteAndFormat (Word.WdRecoveryType.wdFormatOriginalFormatting)
            'SendKeys ("^v")
        Else
            .HTMLBody = strBody
        End If
        
        
        If Not blnDisplay Then
            .Send
        End If
    End With

    If bStarted Then
        'If we started Outlook from code, then close it
        oOutlookApp.Quit
    End If

    'Clean up
    Set oItem = Nothing
    Set oOutlookApp = Nothing

End Sub