Private Sub Form_Load()
Call conndb
End Sub
Private Function conndb()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim strCn, sql As String
Dim db_host As String
Dim db_user As String
Dim db_pass As String
Dim db_data As String
Dim banxing, quyu, kemu, tel, nianji As String
Dim thetime As Date
db_host = "122.114.181.75"
db_user = "daishi"
db_pass = "daishi2017!"
db_data = "daishi"
strCn = "DRIVER={MySQL ODBC 5.2 Driver};" & "SERVER=" & db_host & ";" & "DATABASE=" & db_data & ";" & "UID=" & db_user & ";PWD=" & db_pass & ";" & "OPTION=3" & "stmt=SET NAMES gb2312"
cn.open strCn
cn.CursorLocation = adUseClient
sql = "select * from ds_diyform7 where length(g_tel)>0"
rs.open sql, cn
MsgBox rs.Fields(2) & rs.Fields(6)
While rs.EOF = False And rs.RecordCount > 0
rs.MoveFirst
banxing = Trim(rs!g_banxing)
quyu = Trim(rs!g_quyu)
tel = Trim(rs!g_tel)
nianji = Replace(Trim(rs!g_nianji), "一", "1")
nianji = Replace(Trim(rs!g_nianji), "二", "2")
nianji = Replace(Trim(rs!g_nianji), "三", "3")
nianji = Replace(Trim(rs!g_nianji), "四", "4")
nianji = Replace(Trim(rs!g_nianji), "五", "5")
nianji = Replace(Trim(rs!g_nianji), "六", "6")
nianji = Replace(Trim(rs!g_nianji), "七", "7")
nianji = Replace(Trim(rs!g_nianji), "八", "8")
nianji = Replace(Trim(rs!g_nianji), "九", "9")
thetime = Now
If Len(quyu) = 0 Then quyu = "未填写"
If Len(tel) = 0 Then tel = "未填写"
If Len(banxing) = 0 Then banxing = "未选择"
If Len(nianji) = 0 Then nianji = "未选择"
Exit Function
Dim Email As Object
NameS = "http://schemas.microsoft.com/cdo/configuration/"
Set Email = CreateObject("CDO.Message")
Email.From = "[email protected]"
Email.To = "[email protected]"
Email.Subject = thetime & quyu & nianji
Email.Textbody = "来新资源啦 " & " 发现时间:" & thetime & " 地区：" & quyu & " 联系电话:" & tel & " 科目:" & kemu & " 年级:" & nianji
Email.Configuration.Fields.Item(NameS & "smtpusessl") = "true"
Email.Configuration.Fields.Item(NameS & "sendusing") = 2
Email.Configuration.Fields.Item(NameS & "smtpserver") = "smtp.qq.com"
Email.Configuration.Fields.Item(NameS & "smtpserverport") = 465
Email.Configuration.Fields.Item(NameS & "smtpauthenticate") = 1
Email.Configuration.Fields.Item(NameS & "sendusername") = "2522237381"
Email.Configuration.Fields.Item(NameS & "sendpassword") = "cuohtxtcopljebeg"
Email.Configuration.Fields.Item(NameS & "cc") = "[email protected]"
Email.Configuration.Fields.Update
Email.Send
rs.MoveNext
Wend
End Function