MS Outlook干扰Access vba过程

Question

我使用的是Windows 7 Enterprise和Office 2013 Professional。多年来，我一直使用Access中的以下过程将Outlook中的电子邮件发送给200个或更多我的客户。这些程序使我能够个性化每个电子邮件和任何附件（通过Word邮件合并和pdf）。它简单可靠，节省了大量时间。最近，该程序受到MS Outlook的干扰。查看附件。它迫使我在每封电子邮件上单击“允许”并使我的程序无效。我通过电子邮件发送了三个MS帮助联系人，但他们无能为力。我被告知当时代理人“技术性太强”而且我被告知我会被另一个人联系。到目前为止，没有人联系过我。谁能提出任何建议？问题最近才开始。我想知道是否应该尝试卸载Office的最新更新。 。这是我的程序：

Private Sub EmlSetUP_Click()

If IsNull(Me.Email) Then
    DisplayMessage ("No email address.")
    Exit Sub
Else
    RemoveSchma
    DoCmd.TransferText acExportMerge, "", "qryRetSlip", conAddrPth &   "\DataSource.txt", True, "", 1252
    SndEml
End If

End Sub

Sub SendEml()

Dim objOutlook As New Outlook.Application
Dim objMail As MailItem
Dim Subj As String
Dim Text As String
Dim PathName As String
Dim PathName2 As String

Subj = "DBS Checks"

Text = "I have received a payment for £53.00 which I cannot apply. The  only information given is 'DBS Check'." & vbCr & vbCr & _
   "I'm emailing all possible clients. Is it from you?" & vbCr & vbCr & _
   "Best wishes." & vbCr & vbCr & EmailSig

PathName = conDesktp & "\DBS Checks.xls"
PathName2 = conAddrPth & "\Documents Needed.pdf"

OpenWordDoc2

Set objOutlook = New Outlook.Application
Set objMail = objOutlook.CreateItem(olMailItem)

With objMail
.To = Email
.Subject = Subj
'.DeleteAfterSubmit = True
.Body = Text
.NoAging = True
.Attachments.Add PathName
.Attachments.Add PathName2
'.Display (True)
.Send
End With

Set objMail = Nothing
Set objOutlook = Nothing

End Sub


Private Sub EmlBulk_Click()

Dim rstForm As Recordset
Dim Wrng As Integer

Wrng = MsgBox("WARNING! This will immediately send an email to ALL client  managers." & vbCr & vbCr & "You will not be able to stop it!!!" _
          & vbCr & "Are you certain you have got the text of the email  and any attachments right?", vbCritical + vbDefaultButton2 + vbYesNo, "DBS  Database")

If Wrng = 7 Then
    Exit Sub
Else
    Set rstForm = Forms!frmClientEmail.Form.Recordset

    Do While Not rstForm.EOF
        If IsNull(Me.Email) Then
            rstForm.MoveNext
        Else
            RemoveSchma
            SndEml
            rstForm.MoveNext
        End If
    Loop
End If

DoCmd.Close acForm, "frmClientEmail"
DoCmd.OpenForm "Switchboard"

End Sub

Answer 1

有关讨论和选项列表，请参阅http://www.outlookcode.com/article.aspx?id=52。

基本上你的选择是

1. 安装最新的AV产品
2. 扩展MAPI（仅限C ++或Delphi，无VBA）
3. 第三方产品，例如Redemption或ClickYes。