我需要优化我的代码以避免每次都创建一个新模块。
如何创建更改行号的循环？例如，首先使用第1行（I1、H1和M1）运行代码，然后使用第2行（I2、H2和M2），依此类推。

Function Email()
Dim iMsg, iConf, Flds

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

With Flds
    schema = "http://schemas.microsoft.com/cdo/configuration/"
    .Item(schema & "sendusing") = 2
    .Item(schema & "smtpserver") = "XXXXXXX"
    'Configura a porta de envio de email (porta de saída)
    .Item(schema & "smtpserverport") = XXXX
    .Item(schema & "smtpauthenticate") = 1
    .Item(schema & "sendusername") = "XXXXXXXXXXXX"
    .Item(schema & "sendpassword") = "XXXXXXXXXXXXXX"
    .Item(schema & "smtpusessl") = True
    .Update
End With

With iMsg
    .To = Sheets("Data").Range("I5").Value
    .From = "xxxxxxxxxxxxx"
    .CC = Sheets("Dados").Range("H5").Value
    .Subject = Sheets("Data").Range("K5").Value
    .Sender = "XXXXXXXXXXXXXXXXXXXX"
    .HTMLBody = Sheets("Data").Range("M5").Value`
    Set .Configuration = iConf
End With

Set iMsg = Nothing
Set iConf = Nothing
Set Flds = Nothing
End Function

Sub disparar()
    Email
    MsgBox "Success!", vbOKOnly, "E-mail Sent"
End Sub

有可能做到吗？
我尝试使用ActiveCell和范围A1：A20。
这样行吗？

Function Email()
Dim iMsg, iConf, Flds
Dim xrow As Integer

xrow = 1

Do Until IsEmpty(Range("A" & xrow))

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

    With Flds
        schema = "http://schemas.microsoft.com/cdo/configuration/"
        .Item(schema & "sendusing") = 2
        .Item(schema & "smtpserver") = "XXXXXXX"
        .Item(schema & "smtpserverport") = XXXX
        .Item(schema & "smtpauthenticate") = 1
        .Item(schema & "sendusername") = "XXXXXXXXXXXX"
        .Item(schema & "sendpassword") = "XXXXXXXXXXXXXX"
        .Item(schema & "smtpusessl") = True
        .Update
    End With

    With iMsg
       .To = Sheets("Data").Range("I" & xrow).Value
       .From = "xxxxxxxxxxxxx"
       .CC = Sheets("Data").Range("H" & xrow).Value
       .Subject = Sheets("Data").Range("K" & xrow).Value
       .Sender = "XXXXXXXXXXXXXXXXXXXX"
       .HTMLBody = Sheets("Data").Range("M" & xrow).Value`
        Set .Configuration = iConf
    End With

    Set iMsg = Nothing
    Set iConf = Nothing
    Set Flds = Nothing
Loop
End Function

Sub send()
    Email
    MsgBox "Success!", vbOKOnly, "E-mail Sent"
Loop
End Sub