将访问附件字段作为CDO附件发送到VBA

时间:2016-01-07 23:31:47

标签: vba ms-access email-attachments cdo.message

我有以下代码:

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

在查询中,字段&#34; Grade.Printout&#34;是一个Access附件字段,附带一个文件......在表格中。

我想在cdomsg.AddAttachment中使用这个字段...我知道如果我使用&#34; cdomsg.AddAttachment(&#34;&#34;)&#34;我可以附加一个特定的文件路径...但我想使用Access中的附件字段。

或者有更好的方法吗?任何建议都很棒,谢谢!

1 个答案:

答案 0 :(得分:3)

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