使用 VBA 作为 CDO 附件发送访问附件字段

Question

我有以下代码：

Option Compare Database
Private Sub Command27_Click()

Dim fso, f
Set fso = CreateObject("scripting.FileSystemObject")
Set f = fso.OpenTextFile("M:\Instructor Letter Templates (Typical).htm")
InstructorText = f.ReadAll
f.Close
Set f = Nothing
Set fso = Nothing

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim sql As String

Dim strWhere As String

Set db = CurrentDb()
sql = "SELECT Classes.ClassID, Grade.GradeID, Instructors.RiosaladoEmail, students.sLastName, students.sFirstName, Grade.Form, Grade.Printout FROM students INNER JOIN (Classes INNER JOIN (Instructors INNER JOIN Grade ON Instructors.InstructorID = Grade.[Instructor]) ON Classes.ClassID = Grade.ClassID) ON students.StudentID = Grade.StudentID WHERE Grade.DateProcessed=Date()"
Set rs = db.OpenRecordset(sql, dbOpenDynaset)

Do Until rs.EOF

Dim Class As String
Dim Grade As String
Dim Email As String
Dim Today As String
Dim sLast As String
Dim sFirst As String
Dim Form As String


Class = rs("ClassID")
Grade = rs("GradeID")
Email = rs("RiosaladoEmail")
sLast = rs("sLastName")
sFirst = rs("sFirstName")
Form = rs("Form")

Const cdoSendUsingPickup = 1
Const cdoSendUsingPort = 2
Const cdoAnonymous = 0
Const cdoBasic = 1
Const cdoNTLM = 2

Set cdomsg = CreateObject("CDO.Message")
cdomsg.Subject = sLast & "," & sFirst & Class & Chr(32) & Form
cdomsg.FROM = "<myemail>"
cdomsg.To = Email
cdomsg.HTMLBody = InstructorText
cdomsg.AddAttachment


cdomsg.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

'Name or IP of Remote SMTP Server
cdomsg.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"

'Type of authentication, NONE, Basic (Base64 encoded), NTLM
cdomsg.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic

'Your UserID on the SMTP server
cdomsg.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = "MyEmail"

'Your password on the SMTP server
cdomsg.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "MyPW"

'Server port (typically 25)
cdomsg.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465

'Use SSL for the connection (False or True)
cdomsg.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True

'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)
cdomsg.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60

cdomsg.Configuration.Fields.Update

cdomsg.Send

rs.MoveNext
Loop

Set rs = Nothing
Set db = Nothing

End Sub

在查询中，字段 "Grade.Printout" 是一个 Access 附件字段，在 table.

中附加了一个文件...

我想将此字段与 cdomsg.AddAttachment 一起使用...我知道如果我使用 "cdomsg.AddAttachment ("")" 我可以附加特定的文件路径...但我想使用Access 中的附件字段。

或者有更好的方法吗？任何建议都会很棒，谢谢！

Answer 1

需要为 CDO AddAttachment 方法提供要附加的文件的位置，并且它无法识别对 Access table/field 的引用。因此，您需要使用 Access DAO Field2 对象的 SaveToFile 方法将 Access 附件保存到临时位置，然后将该文件的路径传递给 CDO AddAttachment 方法。

使用 VBA 作为 CDO 附件发送访问附件字段

Send Access Attachment Field as a CDO Attachment with VBA

vba

ms-access

email-attachments

cdo.message