ms 访问在 windows 10 内发送电子邮件

Question

我在 ms-access 2010 中创建了一个程序，可以通过 outlook 向某人发送电子邮件（使用我提供的详细信息打开一个新的邮件格式）它运行良好。

我已经将 os 升级到 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: 消息框 (Err.Description) DoCmd.Close 表格，"Attach" ' 消息框 Error.Description 结束函数

我如何修改它以适应 windows 10？或者我应该 return 到 windows 7？谢谢大家

Answer 1

我更改了此函数以使用后期绑定。这是一篇关于后期绑定与早期绑定的 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

ms 访问在 windows 10 内发送电子邮件

ms access send email in windows 10

windows

email

ms-access-2010