程序循环问题

qjy321

Sub 批量发送邮件带附件() 'QQ邮箱
Dim CDO As Object, i, arr 'CDO对象
Const sSchema = "http://schemas.microsoft.com/cdo/configuration/" '微软CDO服务器网址
Set CDO = CreateObject("CDO.Message") '创建CDO对象
arr = [a1].CurrentRegion
With CDO.Configuration.Fields '操作CDO对象
.Item(sSchema & "sendusing") = 2 '发送方式
.Item(sSchema & "smtpserver") = "smtp.QQ.com" 'smtp服务器地址
.Item(sSchema & "smtpauthenticate") = 1 '服务器认证方式
.Item(sSchema & "sendusername") = "qjyx209@QQ.com" '发件人名称
.Item(sSchema & "sendpassword") = "laqswbabfaf" '开通smtp账户的授权码
.Item(sSchema & "smtpserverport") = 465 'smtp服务器端口
.Item(sSchema & "smtpusessl") = True '是否使用SSL
.Item(sSchema & "smtpconnectiontimeout") = 10 '连接服务器超时时间
.Update '更新设置
End With
For i = 2 To UBound(arr)


CDO.To = arr(i, 1) '收件人
CDO.from = "qjyx209@QQ.com" '发件人邮箱
CDO.Subject = arr(i, 2) '主题
CDO.textbody = arr(i, 3) '纯文本邮件内容
CDO.AddAttachment arr(i, 4)
CDO.send '发送
If Err.Number <> 0 Then
arr(i, 5) = "发送失败"
Else
arr(i, 5) = "发送成功"
End If
Next


[a1].CurrentRegion = arr
MsgBox "发送完成!", 64, "提示!"
Set CDO = Nothing
End Sub

向各位大神求教：程序从第二行循环到第一列最后一行不为空的的循环怎么写？

ykcbf1100

if arr(i,1)<>Empty then
是这样吗？

yjh_27

For i = 2 To UBound(arr)
Do while arr(i,1)=""
if i=UBound(arr) then Exit for
i=i+1
Loop