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

<强>解释

第一个子组从具有硬编码的收件人地址等的子组件更改为基于参数的子组件。它现在可以通过传递这些参数的其他子程序运行。

第二个子就是这样做的。它遍历A2到A100中的每个单元格，并使用该行中的数据调用第一个子单元。在执行此操作时，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方法设置它们。正如您在代码中看到的那样，可以跳过此步骤，并在Offset命令中直接使用Call方法。

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

如何在VBA中逐行重复Sub？

2 个答案: