VBA отправляет электронную почту с шаблоном, используя значение ячейки в качестве получателей - PullRequest
Новая
       15

VBA отправляет электронную почту с шаблоном, используя значение ячейки в качестве получателей

0 голосов
/ 04 мая 2018

Я хотел бы спросить, если что-то не так с приведенным ниже кодом, я хочу отправить электронное письмо, используя шаблон (oft file) и используя значение ячейки (начиная с k9 до последней ячейки, которая имеет значение) в качестве получателей. когда я нажимаю «выполнить», ошибки не возникает, но электронное письмо не было отправлено.

если я удалю нижнюю часть кода, электронное письмо может быть отправлено, но только для значения 1 ячейки.

dim i как целое число тусклый последний как целое число

lastrow = application.worksheetfunction.counta (ws.range ("k: k"))

для i = 9 до последней

следующий я

если я уберу вышеуказанный 5-строчный код и установлю значение sendid = ws.range ("k9")., Marco может работать и электронное письмо может быть отправлено, 

enSub sumit()

Dim SendID
Dim Subject
Dim Body
Dim otlapp As Object
Dim olMail As Object
Dim olMail1 As Object
Dim i As Integer
Dim lastrow As Integer
Dim ws As Object

Set otlapp = CreateObject("Outlook.Application")
Set olMail = otlapp.CreateItemFromTemplate("\\cpadm001.corp.ocalwa.com\clk\DEPT\CLKDEPT6\IMT\SAO\SSC\Team\Team1\Script\IT Services.oft")
Set olMail1 = otlapp.CreateItemFromTemplate("\\cpadm001.corp.ocalwa.com\clk\DEPT\CLKDEPT6\IMT\SAO\SSC\Team\Team1\Script\Email Policy.oft")

Set doc = olMail.GetInspector.WordEditor
Set doc1 = olMail1.GetInspector.WordEditor
Set ws = ThisWorkbook.Worksheets("Send Letters")

vTemplateBody = olMail.HTMLBody
vTemplateBody1 = olMail1.HTMLBody



Subject = "Introduction to IT Services"
Subject1 = "Corporate Email Policy"
HTMLBody = vTemplateBody
HTMLBody1 = vTemplateBody1

lastrow = Application.WorksheetFunction.CountA(ws.Range("k:k"))



For i = 9 To lastrow

SendID = ws.Range("k" & i).Value

With olMail
.SentOnBehalfOfName = "ITSC@ocalwa.com"
.To = SendID
If CCID <> "" Then
  .CC = CCID
End If

.Subject = Subject

Set WrdRng = doc.Range
WrdRng.Paste
.Send

End With

With olMail1
.SentOnBehalfOfName = "ITSC@ocalwa.com"
.To = SendID
If CCID <> "" Then
  .CC = CCID
End If

.Subject = Subject1

Set WrdRng = doc1.Range
WrdRng.Paste
.Send
End With

Next i

End Sub

любая помощь ???? спасибо

Ответы [ 2 ]

0 голосов
/ 09 мая 2018

Объединять, а не перезаписывать, если в одном письме должно быть несколько адресов. 

.To = .To & ";" & SendID

CountA может быть сложнее в использовании, чем реализовано. 

' If rows 1 to 8 are empty
lastrow = 8 + Application.WorksheetFunction.CountA(ws.Range("k:k"))
Debug.Print " lastrow where rows 1 to 8 are empty : " & lastrow
0 голосов
/ 04 мая 2018

Я думаю, вам нужно включить часть, создающую вашу почту, в цикл, мне кажется, что почта отправляется только первому получателю, и тогда не остается никакого объекта - не знаю, как лучше описать .

Попробуйте следующее после ваших деклараций: 

lastrow = Application.WorksheetFunction.CountA(ws.Range("k:k"))

For i = 9 To lastrow
    Set otlapp = CreateObject("Outlook.Application")
    Set olMail = otlapp.CreateItemFromTemplate("\\cpadm001.corp.ocalwa.com\clk\DEPT\CLKDEPT6\IMT\SAO\SSC\Team\Team1\Script\IT Services.oft")
    Set olMail1 = otlapp.CreateItemFromTemplate("\\cpadm001.corp.ocalwa.com\clk\DEPT\CLKDEPT6\IMT\SAO\SSC\Team\Team1\Script\Email Policy.oft")
    Set doc = olMail.GetInspector.WordEditor
    Set doc1 = olMail1.GetInspector.WordEditor
    Set ws = ThisWorkbook.Worksheets("Send Letters")

    vTemplateBody = olMail.HTMLBody
    vTemplateBody1 = olMail1.HTMLBody
    Subject = "Introduction to IT Services"
    Subject1 = "Corporate Email Policy"
    HTMLBody = vTemplateBody
    HTMLBody1 = vTemplateBody1
    SendID = ws.Range("k" & i).Value
    With olMail
        .SentOnBehalfOfName = "ITSC@ocalwa.com"
        .To = SendID

        If CCID <> "" Then
            .CC = CCID
        End If

        .Subject = Subject
        Set WrdRng = doc.Range
        WrdRng.Paste
        .Send
    End With

    With olMail1
        .SentOnBehalfOfName = "ITSC@ocalwa.com"
        .To = SendID
        If CCID <> "" Then
            .CC = CCID
        End If

        .Subject = Subject1

        Set WrdRng = doc1.Range
        WrdRng.Paste
        .Send
    End With
Next i
End Sub
...