我已经在ms-access 2010中创建了一个程序,该程序通过outlook向某人发送电子邮件(打开一个新的邮件格式,其中包含我提供的详细信息)它运行良好。
我已将我的操作系统升级到Windows 10(在Windows 7之前),现在它不发送电子邮件
这是我的代码:
Public Function SendEMail(ByRef IDAzmana As String, ByRef Lakoah As String, ByRef stDocName As String, ByVal strTo As String, ByVal MyBodyText As String)
On Error GoTo err_proc
Dim db As DAO.Database
Dim MailList As DAO.Recordset
' Late binding for outlook 2010 (Outlook.Application ->Object)
Dim MyOutlook As Object ' Outlook.Application 'Need reference to MS Outlook 12.0 Object Library
Dim MyMail As Object 'Outlook.MailItem
Dim Subjectline As String '
Dim BodyFile As String
Dim fso As FileSystemObject 'Need reference to MS Scripting RunTime
Dim MyBody As TextStream
DoCmd.OpenForm "Attach"
Forms![attach]![Name] = "open outlook mail"
Forms![attach].Repaint
Set fso = New FileSystemObject
Subjectline = "print order " & IDAzmana & " of " & Lakoah
MsgBox ("Call Outlook Object")
' Now, we open Outlook for our own device..
Set MyOutlook = New Outlook.Application 'Need reference to MS Outlook 12.0 Object Library
' Set up the database and query connections
MsgBox ("Set up database")
Set db = CurrentDb()
Set MailList = db.OpenRecordset("MyEmailAddresses")
' now, this is the meat and potatoes.
' this is where we loop through our list of addresses,
' adding them to e-mails and sending them.
If MyBodyText <> "tech" Then 'Not need to send again when sending to technician
Do Until MailList.EOF
' This creates the e-mail
Set MyMail = MyOutlook.CreateItem(olMailItem)
strTo = strTo & MailList!EMail & ";"
MyMail.To = MailList("EMail")
MailList.MoveNext
Loop
Else
MsgBox ("CreateItem")
Set MyMail = MyOutlook.CreateItem(olMailItem)
MyMail.To = strTo
End If
'This gives it a subject
MsgBox ("Subject: Subjectline")
MyMail.Subject = Subjectline$
'This gives it the body
MyMail.Body = MyBodyText
MsgBox ("Send Mail")
DoCmd.SendObject acSendReport, stDocName, acFormatPDF, strTo, , , Subjectline, MyBodyText, True
MsgBox ("Mail Sent")
'Cleanup after ourselves
Set MyMail = Nothing
Set MyOutlook = Nothing
MailList.Close
Set MailList = Nothing
db.Close
Set db = Nothing
DoCmd.Close acForm, "Attach"
Exit Function
err_proc: MsgBox(Err.Description) DoCmd.Close acForm,&#34; Attach&#34; &#39; MsgBox Error.Description 结束功能
如何修改它以适应Windows 10?还是我应该回到Windows 7? 谢谢大家。
答案 0 :(得分:0)
我更改了此功能以使用后期绑定。这是关于晚期绑定与早期绑定的MS文章。
https://support.microsoft.com/en-ca/kb/245115
代码未经测试,让我们知道它是怎么回事!
Public Function SendEMail(ByRef IDAzmana As String, ByRef Lakoah As String, ByRef stDocName As String, ByVal strTo As String, ByVal MyBodyText As String)
On Error GoTo err_proc:
Dim db As DAO.Database
Dim MailList As DAO.Recordset
Dim MyOutlook As Object
Dim MyMail As Object
Dim Subjectline As String
Dim BodyFile As String
Dim fso As FileSystemObject 'Need reference to MS Scripting RunTime
Dim MyBody As TextStream
DoCmd.OpenForm "Attach"
Forms![attach]![Name] = "open outlook mail"
Forms![attach].Repaint
Set fso = New FileSystemObject
Subjectline = "print order " & IDAzmana & " of " & Lakoah
MsgBox ("Call Outlook Object")
' Now, we open Oulook for our own device
Set MyOutlook = CreateObject("Outlook.Application") ' Create the Outlook Object
' Set up the database and query connections
MsgBox ("Set up database")
Set db = CurrentDb()
Set MailList = db.OpenRecordset("MyEmailAddresses")
' now, this is the meat and potatoes.
' this is where we loop through our list of addresses,
' adding them to e-mails and sending them.
If MyBodyText <> "tech" Then 'Not need to send again when sending to technician
Do Until MailList.EOF
' This creates the e-mail
Set MyMail = MyOutlook.CreateItem(0) ' 0 is the enum for olMail item
strTo = strTo & MailList!Email & ";"
MyMail.To = MailList("EMail")
MailList.MoveNext
Loop
Else
MsgBox ("CreateItem")
Set MyMail = MyOutlook.CreateItem(0)
MyMail.To = strTo
End If
'This gives it a subject
MsgBox ("Subject: Subjectline")
MyMail.Subject = Subjectline$
'This gives it the body
MyMail.Body = MyBodyText
MsgBox ("Send Mail")
DoCmd.SendObject acSendReport, stDocName, acFormatPDF, strTo, , , Subjectline, MyBodyText, True
MsgBox ("Mail Sent")
'Cleanup after ourselves
Set MyMail = Nothing
Set MyOutlook = Nothing
MailList.Close
Set MailList = Nothing
db.Close
Set db = Nothing
DoCmd.Close acForm, "Attach"
Exit Function
End Function