Question

我想问下面的代码是否有任何问题，我想使用模板（oft文件）发送电子邮件并使用单元格值（从k9开始到具有值的最后一个单元格）作为收件人。当我按下运行但没有发送电子邮件时没有错误。

如果我远程搜索代码的下面部分，则可以发送电子邮件，但仅限于1个单元格的值。

将整数调整为整数昏暗的拉斯特罗为整数

lastrow = application.worksheetfunction.counta（ws.range（“k：k”））

对于i = 9到lastrow

下一个

如果我删除上面的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

任何帮助????谢谢

Answer 1

我认为你需要在循环中包含创建邮件的部分，它看起来像邮件只发送给第一个收件人然后没有任何对象 - 不知道如何描述得更好。

在你的declearations后尝试以下：

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

Answer 2

如果一封邮件中有多个地址，则连接而不是覆盖。

.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

VBA使用单元格值作为收件人发送带有模板的电子邮件

2 个答案: