如何在 VBA 中逐行重复 Sub？

Question

我已经能够通过 Gmail 从 Excel 发送电子邮件，某些 Excel 单元格定义了电子邮件的元数据、正文和附件。

这个子显然只在选定的单元格上运行。理想情况下，我希望这个子在第一行（在这种情况下为第 2 行）运行，然后在下一行运行，直到它到达末尾。

最终目标是能够通过 Excel 自动发送自定义电子邮件。

这是我目前所拥有的。

Sub CDO_Mail_Small_Text_2()
    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
    Dim Flds As Variant

    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") = "MYEMAIL"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "MYPASSWORD"
        .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") = 25
        .Update
    End With

    If Sheets("Data").Range("G2").Value = "Statement" Then
    strbody = "Test" & Sheets("Data").Range("E2").Value
    Else
    strbody = "Test 2"
    End If

    With iMsg
        Set .Configuration = iConf
        .To = Sheets("Data").Range("A2").Value
        .CC = ""
        .BCC = ""
        .ReplyTo = Sheets("Data").Range("D2").Value
        .From = Sheets("Data").Range("C2").Value & "<EMAIL>" 'This just changes the name, the email will come from 'sendusername' above
        .Subject = Sheets("Data").Range("B2").Value
        .TextBody = strbody
        .AddAttachment "" 'don't put in "", just write direct path to file. Possible to do non-local?
        .Send
    End With

End Sub

任何帮助将不胜感激！！谢谢大家。

Answer 1

您需要两个订阅者，第一个是现有的，因此发送一封电子邮件，第二个用于呼叫第一个以获取一组电子邮件地址。

对于第一个，CDO_Mail_Small_Text_2，进行这些更改以使其“参数化”（而不是现在的硬编码版本）：

' Add some parameters to the Sub declaration
Sub CDO_Mail_Small_Text_2(RecipientAddress As String, ReplyToAddress As String, _
    Subject As String, FromAddress As String, Statement As String, _
    ValueOfColumnE As String)

    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
    Dim Flds As Variant

    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") = "MYEMAIL"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "MYPASSWORD"
        .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") = 25
        .Update
    End With

    If Statement = "Statement" Then
        strbody = "Test" & ValueOfColumnE 'Use sub parameter
    Else
        strbody = "Test 2"
    End If

    With iMsg
        Set .Configuration = iConf
        .To = RecipientAddress 'Use sub parameter
        .CC = ""
        .BCC = ""
        .ReplyTo = ReplyToAddress 'Use sub parameter
        .From = FromAddress 'Use sub parameter
        .Subject = Subject 'Use sub parameter
        .TextBody = strbody 
        .AddAttachment "" 
        .Send
    End With
End Sub

第二个，我们称之为 Send_Messages，应该如下所示：

Sub Send_Messages()
    Dim RecipientAddress As String, ReplyToAddress As String, _
    Subject As String, FromAddress As String, Statement As String, _
    ValueOfColumnE As String

    ' change to match length of recipient list
    For Each i in Sheets("Data").Range("A2:A100") 
        RecipientAddress = i.Value
        ReplyToAddress = i.Offset(0,3).Value
        Subject = i.Offset(0,1).Value
        FromAddress = i.Offset(0,2).Value
        Statement = i.Offset(0,6).Value
        ValueOfColumnE = i.Offset(0,4).Value

        Call CDO_Mail_Small_Text_2(RecipientAddress, ReplyToAddress, Subject, _
        FromAddress, Statement, ValueOfColumnE)

        ' Shorter alternative (the above variable declarations wouldn't be needed, then
        ' Call CDO_Mail_Small_Text_2(i.Value, i.Offset(0,3).Value, i.Offset(0,1).Value, _
        'i.Offset(0,2).Value, i.Offset(0,6).Value, i.Offset(0,4).Value)
    Next i
End Sub

说明：

第一个 sub 已从带有硬编码收件人地址等的 sub 更改为基于参数的 sub。它现在可以由传递这些参数的其他潜艇运行。

第二个潜艇就是这样做的。它遍历 A2 到 A100 中的每个单元格，并使用该行中的数据调用第一个 sub。在这样做的同时，i 成为 A 列中的这个单元格，因此在第一次运行中，i 等于 Sheets("Data").Range("A2")。 A 列包含收件人，B 列包含主题行，依此类推。要将主题行（和其余参数）传递给CDO_Mail_Small_Text_2 子，我们使用.Offset(rows, cols) 方法。它用于通过与另一个单元格的相对距离来引用单元格，即i 等于A2，因此i.Offset(0,1) 等于B2 而i.Offset(1,0) 等于A3。为了更容易理解，我为参数声明变量并使用Offset 方法设置它们。在代码中可以看到，这一步可以跳过，直接在Call命令中使用Offset方法。

Answer 2

使用 For 循环来实现：

nRows = Cells(Rows.Count, 1).End(xlUp).Row
For i=2 To nRows
   //your code here, but referring to i instead of row 2...
Next

例如，您在哪里引用这样的行：

 .To = Sheets("Data").Range("A" & i).Value