MS Outlook stört eine Access VBA-Prozedur

Question

Ich verwende Windows 7 Enterprise und Office 2013 Professional. Seit Jahren verwende ich die unten beschriebenen Verfahren in Access, um E-Mails in Outlook an 200 oder mehr meiner Kunden gleichzeitig zu senden. Die Verfahren ermöglichen es mir, jede E-Mail und alle Anhänge zu personalisieren (per Word-Seriendruck und PDF). Es ist einfach und zuverlässig und spart viel Zeit. Vor kurzem wurde das Verfahren von MS Outlook gestört. Siehe angehängte Datei. Es zwingt mich dazu, bei jeder E-Mail auf "Erlauben" zu klicken und mein Verfahren nutzlos zu machen. Ich mailte und sprach mit drei MS-Hilfe-Kontakten, aber sie konnten nicht helfen. Mir wurde gesagt, dass es für den Agenten zu dieser Zeit "zu technisch" war und mir wurde gesagt, dass ich von einer anderen Person kontaktiert werden würde. Niemand hat mich bisher kontaktiert. Kann jemand etwas vorschlagen? Das Problem hat erst kürzlich begonnen. Ich frage mich, ob ich versuchen sollte, das letzte Update zu Office zu deinstallieren. . Hier sind meine Verfahren:

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

Siehe http://www.outlookcode.com/article.aspx?id=52 für die Diskussion und die Liste der Optionen.

Im Wesentlichen sind Ihre Optionen

1. ein up-to-date AV Produkt
2. Extended MAPI (C++ oder Delphi nur, kein VBA) Installation
3. Produkte von Drittanbietern wie Redemption oder ClickYes.