Создайте электронное письмо с содержимым в порядке: текст, изображение, текст, изображение, текст, подпись

ProgramBox

Создайте электронное письмо с содержимым в порядке: текст, изображение, текст, изображение, текст, подпись

Post author:admin
Запись опубликована:14 декабря, 2022
Post category:Вопросы по программированию

#excel #vba #outlook #ms-word

Вопрос:

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

Я не могу найти ничего, где электронное письмо находится в этом формате:

Слова
Изображение
Слова
Изображение
Слова
Подпись

Я нашел те, которые представляют собой слова, изображение, изображение и подпись, которые я использовал для создания своего.

Вот как это выглядит:

Вот как это должно выглядеть:

Я оставил все, что пробовал, как закомментированные разделы.

 Sub EmailGenerate()
    
    Dim objOutApp As Object, objOutMail As Object
    Dim strBody As String, strSig As String, strEnd As String, strBody2 As String
    Dim rng As Range, rng2 As Range
    Dim r As Long, r2 As Long
    Dim wdDoc As Word.Document
    Dim Selection As Word.Selection
    Dim Selection2 As Word.Selection
     
    r = shEmail.Cells(Rows.Count, 15).End(xlUp).Row
    Set rng = shEmail.Range("K1:" amp; Cells(r, 21).Address)
    
    r2 = shEmail.Cells(Rows.Count, 23).End(xlUp).Row
    Set rng2 = shEmail.Range("W1:" amp; Cells(r2, 29).Address)
    
    Set objOutApp = CreateObject("Outlook.Application")
    Set objOutMail = objOutApp.CreateItem(0)
    Set wdDoc = objOutMail.GetInspector.WordEditor
     
    With objOutMail
        'If sent on behalf of another email address
        ' .SentOnBehalfOfName = ""
        'Setting the email conditions
        .To = shEmail.Cells(1, 2).Value
        .CC = shEmail.Cells(2, 2).Value
        .BCC = ""
        'Checks all email names
        .Recipients.ResolveAll
        .Subject = shEmail.Cells(4, 2).Value
        'This must be visible to get the default signature
        .Display
        'Get the html code from the signature
        strSig = .htmlbody
        'This is what the email body should say
      
       ' rng.Copy
       ' wdDoc.Application.Selection.Start = Len(strBody)
       ' wdDoc.Application.Selection.End = wdDoc.Application.Selection.Start
       ' wdDoc.Application.Selection.PasteAndFormat (wdChartPicture)
       ' wdDoc.Content.InsertParagraphAfter
       ' rng2.Copy
       ' wdDoc.Application.Selection.Start = Len(strBody)   Len(strBody2)
       ' wdDoc.Application.Selection.End = wdDoc.Application.Selection.Start
       ' wdDoc.Application.Selection.PasteAndFormat (wdChartPicture)
      
       ' rng1.Copy
       ' wdDoc.Paragraphs(2).Range.PasteSpecial , , , , wdPasteBitmap
      
        rng.Copy
        wdDoc.Content.InsertParagraphBefore
        wdDoc.Paragraphs(2).Range.PasteSpecial , , , , wdPasteBitmap
        wdDoc.Content.InsertParagraphAfter
      
        strBody = "<Body style=font-size:11pt;font-family:Calibri>" amp; _
          shEmail.Cells(5, 2).Value amp; "</p>" amp; _
          "<p>" amp; "</p>" amp; _
          "<p>" amp; shEmail.Cells(6, 2).Value amp; "</p>" amp; _
          "<p>" amp; shEmail.Cells(7, 2).Value amp; "</p>" amp; _
          "<p>" amp; "</p>" amp; _
          "<p>" amp; shEmail.Cells(8, 2).Value amp; "</p>"
          
        strBody2 = "<Body style=font-size:11pt;font-family:Calibri>" amp; _
          shEmail.Cells(10, 2).Value amp; "</p>" amp; _
          "<p>" amp; "</p>"
       
        rng2.Copy
        wdDoc.Content.InsertParagraphBefore
        wdDoc.Paragraphs(1).Range.PasteSpecial , , , , wdPasteBitmap
        wdDoc.Content.InsertParagraphAfter
        
        objOutMail.htmlbody = strBody2 amp; _
          .htmlbody
         
        ' rng2.Copy
        ' wdDoc.Application.Selection.Start = Len(strBody)   Len(strBody2)
        ' wdDoc.Application.Selection.End = wdDoc.Application.Selection.Start
        ' wdDoc.Application.Selection.PasteAndFormat (wdChartPicture)
    
        'Combines the email with image and the signature
        objOutMail.htmlbody = strBody amp; _
          .htmlbody
      
        'Automatically sends the email, should pop up briefly.
        '.Send
    
    End With
    
    On Error GoTo 0
    Set objOutMail = Nothing
    Set objOutApp = Nothing
     
End Sub

rng — это таблица большего размера, а rng2 — таблица меньшего размера.

. Ячейки (5,2) до (8,2) идут перед rng, а (10,2) идут после rng и перед rng2, тогда (12,2) будет идти после rng2 и перед подписью.

1. Стивен привет — информация очень понятна, но я не уверен, в чем точный вопрос: не могли бы вы мне немного помочь? Спасибо

2. Привет, Джон, спасибо за ответ. Извиняюсь, что мой вопрос был не очень ясен. Я хотел бы получить помощь в том, где мой код неверен. Или руководство по лучшему способу перевода его в формат, который мне нужен. Я добавил краткое объяснение под кодом, чтобы показать, что должно идти в соответствии с кодом. Я надеюсь, что это имеет смысл. Спасибо

3. одно быстрое наблюдение — вы можете знать, но если нет "<p>" amp; "</p>" , это не даст вам разрыв строки, вы можете попробовать </br>

4. Я этого не знал, спасибо.

5. months и completed — вы ищете, чтобы это были гиперссылки? если да, то как вы создаете html для этого?

Ответ №1:

Пожалуйста, попробуйте следующий подход. WordEditor По крайней мере, я этого не делал, и я не знаю, как / если это можно сделать. Все (я понял), что вам нужно, можно сделать с помощью WordEditor object или html, используя PropertyAccessor и ссылки на пути к изображениям. Я использую только ваш адаптированный код WordEditor :

 Sub EmailGenerate()
 Dim objOutApp As Object, objOutMail As Object
 Dim rng As Range, rng2 As Range, shEmail As Worksheet
 Dim r As Long, r2 As Long
 Dim wdDoc As Word.document, wdRange As Word.Range
 
 Set shEmail = ActiveSheet 'use here your necessary sheet
 
 r = shEmail.cells(Rows.count, 15).End(xlUp).row
 Set rng = shEmail.Range("K1:" amp; cells(r, 21).Address)

 r2 = shEmail.cells(Rows.count, 23).End(xlUp).row
 Set rng2 = shEmail.Range("W1:" amp; cells(r2, 29).Address)

 Set objOutApp = CreateObject("Outlook.Application")
 Set objOutMail = objOutApp.CreateItem(0)
 Set wdDoc = objOutMail.GetInspector.WordEditor
  
 With objOutMail
    'If sent on behalf of another email address
    '.SentOnBehalfOfName = ""
    'Setting the email conditions
    .To = shEmail.cells(1, 2).Value
    .cc = shEmail.cells(2, 2).Value
    .BCC = ""
    'Checks all email names
    .Recipients.ResolveAll
    .subject = shEmail.cells(4, 2).Value
    'This must be visible to get the default signature
    .display 'Please, look here if its appearance is what you need.
    
    'Declare the string variables to be used:
    Dim strFrst As String, strSec As String, strThird As String, strF As String
    
    'Give values to the strings (they can take the values from the sheet...)
    strFrst = "Hello All!" amp; vbCrLf amp; vbCrLf
    strSec = "Please, receive the picture you requested:" amp; vbCrLf amp; vbCrLf
    strThird = "And the second picture is following:" amp; vbCrLf amp; vbCrLf
    strF = "The last necessary string is here..." amp; vbCrLf
    
    'Write the first two text lines:________________
    wdDoc.Paragraphs(1).Range.InsertAfter (strFrst)
    wdDoc.Paragraphs(2).Range.InsertAfter (vbCrLf) 'insert an empty line
    wdDoc.Paragraphs(3).Range.InsertAfter (strSec)
    '_______________________________________________
    
    'Embed the first picture__________________________________________
    rng.Copy
    wdDoc.Paragraphs(5).Range.PasteSpecial , , , , wdPasteBitmap
    '_________________________________________________________________
    
    wdDoc.Paragraphs(5).Range.InsertAfter (vbCrLf) 'empty line after first picture
    
    'insert the third string:_______________________
    wdDoc.Paragraphs(6).Range.InsertAfter (strThird)
    '_______________________________________________
      
    'Embed the second picture___________________________________
    rng2.Copy
    wdDoc.Paragraphs(8).Range.PasteSpecial , , , , wdPasteBitmap
    '___________________________________________________________
    
    'insert the fourth string:__________________
    wdDoc.Paragraphs(8).Range.InsertAfter (strF)
    '___________________________________________
    
    
    'Automatically sends the email, should pop up briefly.
    '.Send
 End With
End Sub

Пожалуйста, протестируйте его и отправьте отзыв.

1. @Steven Byrne: Это означает только то, что я хотел показать вам способ работы (только) с WordEditor тем, чтобы вставлять картинки или строки везде, где вам нужно. Если недостаточно ясно, я адаптирую код, чтобы вставить другую строку в конце…

2. @Steven Byrne: Вы имеете в виду, что сначала у вас есть изображение, а затем текст? Если да, то в моем случае этого не происходит… Вы пробовали код как есть или внесли некоторые (возможно, небольшие) корректировки? Пожалуйста, поставьте точку разрыва rng.Copy , а затем запустите код построчно (нажав F8) и посмотрите, что происходит…

3. Я больше не могу оставаться… Я должен покинуть свой офис за несколько минут до этого. Мы можем продолжить это обсуждение через несколько часов, когда я буду дома.

4. @Steven Byrne: Пожалуйста, протестируйте обновленный код. Я создал подпись и начал играть с WordEditor объектом. Я думаю, это работает так, как должно… Пожалуйста, отправьте отзыв после его тестирования.

5. @Steven Byrne: Рад, что смог помочь! Я также кое-чему научился во время игры WordEditor . По неизвестной причине добавление пустой строки ( vbCrLf ) не добавит такую видимую строку, но в противном случае первый абзац «займет» строку из начального пробела между верхней стороной страницы почты и строкой подписи. Когда вам нужна такая пустая строка, вы должны создать еще один абзац…