使用VBA将Access附件字段作为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附件字段，其上附有一个文件。。。在一张桌子上。

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

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

Answer 1

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