刷新数据库内容并发送到邮件

gareth · 发表于 2014-10-8 13:12

我有一软件会不断更新内容到一个MDB数据库文件内，现想达到：将该MDB数据库更新的内容，按关键字（包含某字符）筛选出来并发送到指定邮箱，有没高手可以写个宏代码呀？多谢！

onlycxb · 发表于 2014-10-8 13:17

当然可以。只不过你的要求太宏观，没法写代码。

gareth · 发表于 2014-10-8 16:15

本帖最后由 gareth 于 2014-10-8 16:27 编辑

onlycxb 发表于 2014-10-8 13:17
当然可以。只不过你的要求太宏观，没法写代码。

我添加了附件了，请参考，多谢！数据就在表CallLog内，当列result的内容包含字符“返回按键”时，则将该列result及phonenum列所在行的内容一起发送到邮箱admin@test.com，例如发出的内容为“13870176388回铃; 呼叫接通; 返回按键0”

db1.rar (18.25 KB, 下载次数: 182)

onlycxb · 发表于 2014-10-9 20:56

本帖最后由 onlycxb 于 2014-10-10 06:14 编辑

去采摘一天,才回来.简单写了个代码,请测试!

Sub SendMail()
Dim Conn As ADODB.Connection, rst As ADODB.Recordset, MyData As String, StrSql As String, arr
Dim olApp As Object, oitem As Object, i%
MyData = "db1.mdb"
Set Conn = New ADODB.Connection
Set rst = New ADODB.Recordset
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "" & MyData
If Conn.State = adStateOpen Then
StrSql = "Select * From [CallLog] "
rst.Open StrSql, Conn, adOpenStatic
End If
arr = Application.WorksheetFunction.Transpose(rst.GetRows)
Set olApp = CreateObject("outlook.application")
For i = 1 To UBound(arr, 1)
If InStr(arr(i, 8), "返回按键") Then
Set oitem = olApp.CreateItem(olMailItem)
With oitem
.Subject = ""
.To = "admin@ test.com"
.Body = arr(i, 2) & arr(i, 8)
.Send
End With
Set oitem = Nothing
End If
Next i
Set olApp = Nothing
End Sub
'以上代码假定数据库db1.mdb与代码文件在同一个文件夹内,可根据需要灵活修改.DongYu(Q:470208739)

复制代码

gareth · 发表于 2014-10-10 17:08

onlycxb 发表于 2014-10-9 20:56
去采摘一天,才回来.简单写了个代码,请测试!

多谢，我测试一下！！

VBA万岁 · 发表于 2014-10-16 11:37

本帖最后由 VBA万岁于 2014-10-16 11:44 编辑

onlycxb 发表于 2014-10-9 20:56
去采摘一天,才回来.简单写了个代码,请测试!

测试通过，多谢分享！
Mark如附件：

数据库内容并发送到邮件.zip (645.05 KB, 下载次数: 944)

blackttea1 · 发表于 2018-2-26 11:37

做个记号，谢谢！

lokpo766 · 发表于 2019-9-13 10:50

Mark

他乡月 · 发表于 2019-11-30 10:43

真好，非常棒

jjaxuan · 发表于 2020-9-16 11:19

顶一下，收藏起来

		自动登录	找回密码
密码			免费注册

[求助] 刷新数据库内容并发送到邮件