Question

我正在尝试设置一个VB代码，该代码可以根据Sheet 1的“L”列中给出的特定电子邮件地址发送电子邮件。我面临的挑战是添加“.CC”行。我想要的“CC”列表的“电子邮件”地址可在耻辱excel表“Sheet01”的M栏上找到

有人可以建议使用适当的编码将电子邮件拉到CC线吗？

注意：CC列表的长度（M列）不是静态的或是变化的。

谢谢

Sub CDO_Personalized_Mail_Body()
Dim iMsg As Object
Dim iConf As Object
Dim cell As Range
  Dim Flds As Variant

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

iConf.Load -1    ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "Test@gmail.com"  
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "12345@passowrd"  
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
    .Update
End With

For Each cell In Sheets("Sheet1").Columns("L").Cells
        If cell.Value Like "?*@?*.?*" Then
            Set iMsg = CreateObject("CDO.Message")
            With iMsg
                Set .Configuration = iConf
                .To = cell.Value
                .From = """Test User"" <TestUser@gmail.com>" 
                .CC = Sheets("Sheet1").Columns("M").Cells  ' **here i want Insert CC line Email ID** 
                .Subject = "***Important - Email Alert***"
                .TextBody = "Hi " & vbNewLine & vbNewLine & _
                "This is Auto genrated email " & cell.Offset(0, 2).Value & vbNewLine & vbNewLine & _
                            "Thank You"
                .Send
            End With
            Set iMsg = Nothing
    End If
Next cell

With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With

End Sub

Answer 1

范围具有.Row属性，该属性返回其第一行的行号。因此对于单个单元格，cell.Row给出它的行。

Set sh = ActiveWorkbook.Worksheets("Sheet1")

For Each cell In sh.UsedRange.Columns("L").Cells
    ' CC cell: same row, column M
    Set cellCC = sh.Cells(cell.Row, "M")
    Debug.Print cell.Row, cellCC.Value
Next cell

请注意，您应该有一个Sheet.UsedRange。在那里，或For Each将循环遍历整个1,048,576行的工作表。

对于这种任务，我宁愿不使用For Each，而是在以下行上使用“标准”循环，恕我直言，它更易读。

For y = 1 To sh.Columns("L").SpecialCells(xlCellTypeLastCell).Row
    Debug.Print y, sh.Cells(y, "L").Value, sh.Cells(y, "M").Value
Next y

用于发送电子邮件的Excel VB代码：向CC添加电子邮件

1 个答案: