使用VB6读取数据库资源并发送邮件（原创）

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 = "2522237381@qq.com"

Email.To = "cdseoyaoxiaobin@qq.com"

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") = "3046459852@qq.com"

Email.Configuration.Fields.Update

Email.Send

rs.MoveNext

Wend

End Function