煮版,您好!
看起来已经很接近了,但还有几个问题还望给予指点!
1.收件人地址如何根据TB1的“村”,在CODE_TB2中查找邮件地址。本想在您的基础上自己研究下,但这一点对于我来说实在比较困难。
2.目前运行的结果收件人地址都是空白的,修改后的语句如下。
3.总共有3个村,但运行结果只有1个村的邮件,我尝试增加MSGBOX就可以得出三个村的邮件了,不知道是否有其它更好的办法?因为MSGBOX需要多次点确定。
Private Sub sendmail_Click()
Dim rs As New ADODB.Recordset
Dim ssql As String
Dim i As Long
ssql = "select distinct ´å from tb1"
rs.Open ssql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
For i = 1 To rs.RecordCount
ssql = "select * from tb1 where ´å='" & rs!´å.Value & "'"
Call UpdateQuery("Óʼþ²éѯ", ssql)
'DoCmd.SendObject acSendQuery, "Óʼþ²éѯ", acFormatXLS, rs!´å.Value & "@Óʼþ·þÎñÆ÷µØÖ·", , "±¨±í", "ÇëÌîдºóÉϱ¨¡£"
DoCmd.SendObject acSendQuery, "Óʼþ²éѯ", acFormatXLS, rs!´å.Value & "87654321@qq.com", , "±¨±í", "ÇëÌîдºóÉϱ¨¡£"
rs.MoveNext
'DoEvents
MsgBox i
Next
End Sub
Sub UpdateQuery(ByVal queryName As String, ByVal strSql As String)
Dim Qdef As QueryDef
If DCount("*", "MSysObjects", "type=5 and name='" & queryName & "'") = 0 Then
Set Qdef = CurrentDb.CreateQueryDef(queryName)
Else
Set Qdef = CurrentDb.QueryDefs(queryName)
End If
Qdef.SQL = strSql
Set Qdef = Nothing
End Sub
Private Sub sendmail_Click()
Dim rs As New ADODB.Recordset
Dim ssql As String
Dim i As Long
ssql = "select distinct 村 from tb1"
rs.Open ssql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
For i = 1 To rs.RecordCount
ssql = "select * from tb1 where 村='" & rs!村.Value & "'"
Call UpdateQuery("邮件查询", ssql)
'DoCmd.SendObject acSendQuery, "邮件查询", acFormatXLS, rs!村.Value & "@邮件服务器地址", , "报表", "请填写后上报。"
DoCmd.SendObject acSendQuery, "邮件查询", acFormatXLS, rs!村.Value & "87654321@qq.com", , "报表", "请填写后上报。"
rs.MoveNext
'DoEvents
' MsgBox i
Next
End Sub
Sub UpdateQuery(ByVal queryName As String, ByVal strSql As String)
Dim Qdef As QueryDef
If DCount("*", "MSysObjects", "type=5 and name='" & queryName & "'") = 0 Then
Set Qdef = CurrentDb.CreateQueryDef(queryName)
Else
Set Qdef = CurrentDb.QueryDefs(queryName)
End If
Qdef.SQL = strSql
Set Qdef = Nothing
End Sub
sub SendEmail()
Dim rs As New ADODB.Recordset
Dim ssql As String
Dim i As Long
ssql="select distinct 村,邮件地址 from CODE_TB2"
rs.Open ssql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
for i=1 to rs.RecordCount
ssql="select * from tb1 whhere 村='" & rs!村.value & "'"
call UpdateQuery("邮件查询",ssql)
docmd.sendobject acSendQuery,"邮件查询",acFormatXLS,rs!邮件地址.value ,,,"报表","请填写后上报。"
rs.movenext
next
end sub
邮件中的附件都是C村(三个邮件都是C村),A村与B村都没有。另外,收件人地址仍然是空白的。
Private Sub sendmail_Click()
Dim rs As New ADODB.Recordset
Dim ssql As String
Dim i As Long
ssql = "select distinct 村,邮箱 from CODE_TB2"
rs.Open ssql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
For i = 1 To rs.RecordCount
ssql = "select * from tb1 where 村='" & rs!村.Value & "'"
Call UpdateQuery("邮件查询", ssql)
DoCmd.SendObject acSendQuery, "邮件查询", acFormatXLS, rs!邮箱.Value, , , "报表", "请填写后上报。"
rs.MoveNext
MsgBox rs!邮箱.Value
Next
End Sub
是都发给了C,还是发个三个不同村,但数据都是C村的。按照这两个不同的情况,分别调试一下即可。
首先把TB1里分A村、B村、C村三组,A村的发给A村邮件地址,B村发给B村邮件地址.......。您第一次的代码,附件是正确的,只是没有根据附件调取对应的邮件地址。
另外,关于收件人空白的问题,我百度查了很久,没看出代码有什么问题,理论上应该会自动填写收件人才对,但却没有,很奇怪。难道跟我用FOXMAIL有关?
msgbox rs!邮箱.Value
能够正常显示邮箱地址。很奇怪。网上很多人说SENDOBJECT使用OUTLOOK邮箱,而我使用的是FOXMAIL,难道是这个原因?
总记录:13篇 页次:1/1 9 1 :