Как добавить данные Excel в таблицу в шаблоне OFT для отправки по электронной почте с помощью VBA - PullRequest
Новая
       28

Как добавить данные Excel в таблицу в шаблоне OFT для отправки по электронной почте с помощью VBA

0 голосов
/ 24 сентября 2018

Я пытаюсь отправить электронные письма, используя шаблон OFT, на адреса электронной почты, указанные в электронной таблице, с парой столбцов / строк данных Excel, включенных в электронное письмо.

Я собрал несколько идей о том, какнаписать код, и сделали это.Тем не менее, я сталкиваюсь с проблемой, когда таблица не показывает соответствующие данные, какие-либо идеи о том, где я ошибаюсь с моим кодом?

Код отправляет электронное письмо нужным пользователям и создаеттаблица с правильными заголовками таблицы, просто нет данных в таблице

Пример моих данных: 

Email         Company Name   Shortname
a@xyz.com         abc          a
b@xyz.com         smart        sma
a@xyz.com         amex         am
c@xyz.com         buy          by

Код: 

Dim OutApp As Outlook.Application

Sub Send_Emails()

    Dim address As String
    Dim tmpTbl As String
    Dim check As Boolean
    Dim i As Long
    Dim lastRow As Long

    check = User_Logged_In
    If check = False Then
        Exit Sub
    Else
    End If

    Set OutApp = Outlook.Application

    i = 2
    lastRow = Sheet1.UsedRange.Rows.Count
    tmpTbl = ""

    'Loop through Spreadsheet
    Do Until i > lastRow
        If i - 1 > 0 And Sheet1.Cells(i, 1) <> Sheet1.Cells(i - 1, 1) Then
            tmpTbl = "<table border=""1"" cellpadding=""2""><tr><td><b><u>Date</u></b></td><td><b><u>Company Name</u></b></td><td><b><u>Shortname</u></b></td></tr>"
repeatLine:
        End If

        address = Sheet1.Cells(i, 1)

        Call SendMail(address, tmpTbl)

        tmpTbl = ""
        i = i + 1
    Loop

    Set OutApp = Nothing
    MsgBox ("Emails have been sent")
End Sub

Public Function SendMail(aTo, aTable)

      On Error GoTo ErrorHandle
      Dim OutMail As Outlook.mailItem
      Dim path As String

      'Set OutMail = OutApp.CreateItem(0)
      path = "Z:\VBA\Email Macro.oft"
      Set OutMail = OutApp.CreateItemFromTemplate(path)

      With OutMail
          .To = aTo
          .BCC = ""
          .BodyFormat = olFormatHTML
          .HTMLBody = Replace(.HTMLBody, "INSERT_TABLE", aTable)
          '.Display
          .Send
      End With

ErrorExit:
      Set OutMail = Nothing
      Exit Function

ErrorHandle:
      MsgBox ("Error Sending Email to " & aTo & ".  Click Ok and the macro will skip this record.")
      Resume ErrorExit

End Function

Function User_Logged_In() As Boolean

    Dim olApp As Object
    On Error Resume Next

    Set olApp = GetObject(, "Outlook.Application")

    On Error GoTo 0
    If Not olApp Is Nothing Then
        User_Logged_In = True
    Else
        MsgBox ("Please Open Outlook.")
        User_Logged_In = False
    End If
End Function
...