excel 如何在范围(A & Row)中循环遍历行?

fnx2tebb  于 2023-01-31  发布在  其他
关注(0)|答案(1)|浏览(192)

我需要优化我的代码以避免每次都创建一个新模块。
如何创建更改行号的循环?例如,首先使用第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
efzxgjgh

efzxgjgh1#

您应该考虑使用. Offset(iRow、iCol)。
大概是这样的

Set MyBaseRange = Sheets("Data").Range("I5")

For iRow = 0 to 100
   With iMsg
      .To = MyBaseRange.Offset(iRow,0).Value
      .CC = MyBaseRange.Offset(iRow,1).Value
      .Subject = MyBaseRange.Offset(iRow,2).Value
      .HTMLBody = MyBaseRange.Offset(iRow,3).Value
   Set .Configuration = iConf
   End With

   ' Do Work

Next iRow

相关问题