我需要优化我的代码以避免每次都创建一个新模块。
如何创建更改行号的循环?例如,首先使用第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
1条答案
按热度按时间efzxgjgh1#
您应该考虑使用. Offset(iRow、iCol)。
大概是这样的