ms访问在Windows 10中发送电子邮件

时间:2016-05-25 13:32:36

标签: windows email ms-access-2010

我已经在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? 谢谢大家。

1 个答案:

答案 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