非常感谢有点甜老师!!!
思路是这样的,在表中设定好相关邮件地址,是否需要自动发送,发送报告存放的路径和名称,然后每天定时发送。但不知怎么笔记本执行没问题,个别台式机执行提示上贴的错误。 请老师指教!非常感谢!
计划管理
定时发送日报表
Dim i,j As Integer
Dim Mydate As Date
Dim cmd As New SQLCommand
Dim dt As DataTable
Dim CheckTime As Integer
Dim Myhour,SendInterval,SendTime As Integer
Dim SendStatus As String
Dim VendorNames As String()
Dim LastSendTime As Date
Dim ReportTime As Date
Mydate=now()
Myhour=Mydate.hour
Dim drr0 As DataRow
drr0 = DataTables("信息表").DataRows(0)
LastSendTime=drr0("上次自动发送时间")
ReportTime=drr0("报告生成时间")
SendStatus=drr0("邮件发送状态")
SendTime=drr0("定时发送报告时刻点")
Host=drr0("邮件服务器")
HostName=drr0("邮箱账号")
HostPassword=drr0("邮箱密码")
HostMailbox=drr0("发送邮箱")
CheckTime=drr0("检测次数")
If (Myhour=SendTime) Then
CheckTime=Checktime+1
Else
CheckTime=0
End If
drr0("检测次数")=CheckTime
If (Myhour = SendTime And CheckTime=1) Then
For Each dr9 As DataRow In DataTables("邮箱信息表").DataRows
If dr9("是否发送")=True Then
Dim m As New MailSender
m.Host = Host
m.Account = HostName
m.Password = HostPassword
m.From = HostMailbox
m.To = dr9("邮箱地址1")
If dr9("邮箱地址2")<> Nothing Then
m.AddReceiver(dr9("邮箱地址2"))
End If
If dr9("邮箱地址3")<> Nothing Then
m.AddReceiver(dr9("邮箱地址3"))
End If
If dr9("邮箱地址4")<> Nothing Then
m.AddReceiver(dr9("邮箱地址4"))
End If
If dr9("邮箱地址5")<> Nothing Then
m.AddReceiver(dr9("邮箱地址5"))
End If
If dr9("邮箱地址6")<> Nothing Then
m.AddReceiver(dr9("邮箱地址6"))
End If
If dr9("邮箱地址7")<> Nothing Then
m.AddReceiver(dr9("邮箱地址7"))
End If
If dr9("邮箱地址8")<> Nothing Then
m.AddReceiver(dr9("邮箱地址8"))
End If
If dr9("邮箱地址9")<> Nothing Then
m.AddReceiver(dr9("邮箱地址9"))
End If
If dr9("邮箱地址10")<> Nothing Then
m.AddReceiver(dr9("邮箱地址10"))
End If
m.Title = Date.today & dr9("邮件标题")
m.Content = dr9("邮件内容")
If dr9("附件文件1")<> Nothing Then
m.AddAttachments(ReportPath & dr9("附件文件1"))
End If
If dr9("附件文件2")<> Nothing Then
m.AddAttachments(ReportPath & dr9("附件文件2"))
End If
If dr9("附件文件3")<> Nothing Then
m.AddAttachments(ReportPath & dr9("附件文件3"))
End If
If dr9("附件文件4")<> Nothing Then
m.AddAttachments(ReportPath & dr9("附件文件4"))
End If
If dr9("附件文件5")<> Nothing Then
m.AddAttachments(ReportPath & dr9("附件文件5"))
End If
m.SendAsync()
End If
Next
SendStatus="已经发送"
drr0("上次自动发送时间")=now()
drr0("邮件发送状态")="已经发送"
DataTables("信息表").save()
messagebox.show( MyDate & " 报表自动生成和发送完毕!!!!")
'MyTimers("定时发送报告").Enabled = False
End If