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。