Вставьте текстовое содержимое в выбранное ответное письмо в середине тела письма. - PullRequest
Новая
       21

Вставьте текстовое содержимое в выбранное ответное письмо в середине тела письма.

0 голосов
/ 01 апреля 2019

Привет, ребята. У меня проблема с копированием содержания слова в выбранное ответное письмо.Вот мой код. 

Sub ReplyMail_No_Movements_original()

  ' Outlook's constant
  Dim oItem As Outlook.MailItem
  Const olFolderSentMail = 5
  Const olMail = 43

  ' Variables
  Dim OutlookApp As Object
  Dim IsOutlookCreated As Boolean
  Dim sFilter As String, sSubject As String

  ' Get/create outlook object
  On Error Resume Next
  Set OutlookApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlookApp = CreateObject("Outlook.Application")
    IsOutlookCreated = True
  End If
  On Error GoTo 0

  ' Restrict items
  sSubject = ActiveCell.Value
  sFilter = "[Subject] = '" & sSubject & "'"

  ' Main
  With OutlookApp.Session.GetDefaultFolder(olFolderSentMail).Items.Restrict(sFilter)
    If .Count > 0 Then
      .Sort "ReceivedTime", True

      With .item(1).ReplyAll
        .HTMLBody = Cells(ActiveCell.Row, "F") & "<br><br>" & word_rng(oItem) & "<br>" & .HTMLBody '<==Problem part of word_rng(oItem)
        .Display
        .Save
        '.Send
        If Cells(ActiveCell.Row, "H").Text <> "" Then
            .Attachments.Add (Cells(ActiveCell.Row, "H").Text)
        End If

        If Cells(ActiveCell.Row, "I").Text <> "" Then
            .Attachments.Add (Cells(ActiveCell.Row, "I").Text)
        End If

        SendKeys "^+{DOWN}", True
        SendKeys "{DOWN}", True
        SendKeys "{END}", True

        wd.Close False
        Set wd = Nothing

      End With
    Else
      MsgBox "No emails found with Subject:" & vbLf & "'" & sSubject & "'"
    End If
  End With

  ' Quit Outlook instance if it was created by this code
  If IsOutlookCreated Then
    OutlookApp.Quit
    Set OutlookApp = Nothing
  End If

End Sub

Private Function word_rng(oItem As Outlook.MailItem) As Object

    'On Error Resume Next

  Dim WordFile As String
  WordFile = Cells(1, 3).Value

  Dim wd As Object, editor As Object
  Set wd = GetObject(WordFile)
  wd.Content.Copy
  Set editor = oItem.GetInspector.WordEditor
  editor.Content.Paste

    'On Error GoTo 0

End Function

Я хочу скопировать текстовое содержимое файла в это ответное письмо и сохранить старое сообщение.

Это будет выглядеть как

Уважаемый господин.A, <=== Ячейки (ActiveCell.Row, "F") </h1> Содержание копии слова <=== word_rng (oitem) </h1> ================= Старое сообщение <===. Htmlbody </h1> Я хочу вставить содержимое в середину тела письма, но много раз тестировал с помощью .htmlbody или .body.Это все еще не может работать.(У меня есть подпись, поэтому мне нужно использовать .htmlbody Может кто-нибудь знает, как ее решить? Это действительно сводит меня с ума в течение почти недели. Кроме того, формат ответного электронного письма не может сохранить исходный формат. Всепосле использования vba текст будет обрезан как «синий» и не сможет отображать подпись. Некоторый текст должен отображаться красным или желтым цветом, который я отмечал ранее. Но все это становится «синим» Редактировать 1: Я создаюфункция для размещения копии содержимого слова в .htmlbody, но она получила переменную Object error или переменная блока не установлена ​​

...