遠程服務器機器不存在或不可驗（錯誤＃462）

Question

所以我在Mcirosoft Outlook中有此代碼。代碼在新郵件進入時運行，並根據發件人的名稱和附件，保存文本文件並將數據導入到2個訪問數據庫中，並運行預先構建在數據庫中的某些查詢。當來自正確的發件人並且具有正確附件的兩封電子郵件進入時，代碼錯誤輸出。該代碼正確處理第一封電子郵件，但是當第二封電子郵件正在處理時，代碼錯誤輸出在下面粗體行。

Option Explicit 
Private Sub Application_NewMail() 

Dim ns As NameSpace 
Dim inbox As MAPIFolder 
Dim Item As MailItem 
Dim atmt As Attachment 
Dim fso As FileSystemObject 
Dim fs As TextStream 
Dim dt, invfn, misfn, invdr, misdr, dbfn As String 
Dim invt, mist As Boolean 
Dim db As Object 

Set ns = GetNamespace("MAPI") 
Set inbox = ns.GetDefaultFolder(olFolderInbox) 
Set fso = New FileSystemObject 

If inbox.UnReadItemCount = 0 Then 
    Exit Sub 
    Else 
    For Each Item In inbox.Items.Restrict("[UnRead] = True") 
     If Item.SenderName = "Menon, Jayesh" Then 
      dt = Left(Right(Item.Subject, 12), 10) 
      For Each atmt In Item.Attachments 
       If atmt.FileName = "InvalidLoans.txt" Then 
        invfn = "ERLMF_InvalidLoans_" & dt & ".txt" 
        invdr = "C:\Documents and Settings\U299482\Desktop\Data Drop\" & _ 
        invfn 
        atmt.SaveAsFile invdr      
        Set fs = fso.OpenTextFile(invdr) 
        If fs.Read(23) = "Invalid Loans Count = 0" Then 
         invt = False 
         Else 
         invt = True 
        End If 
        fs.Close 
       End If 
       If atmt.FileName = "MissingLoans.txt" Then 
        misfn = "ERLMF_MissingLoans_" & dt & ".txt" 
        misdr = "C:\Documents and Settings\U299482\Desktop\Data Drop\" & _ 
        misfn 
        atmt.SaveAsFile misdr 
        Set fs = fso.OpenTextFile(misdr) 
        If fs.Read(23) = "Missing Loans Count = 0" Then 
         mist = False 
         Else 
         mist = True 
        End If 
        fs.Close 
       End If 
      Next 
      If invt = True Or mist = True Then 
       Set db = CreateObject("Access.Application") 
       dbfn = "C:\Documents and Settings\U299482\Desktop\Databases\BPDashboard.accdb" 
       With db 
        .OpenCurrentDatabase dbfn, True 
        .Visible = True 
        If invt = True Then 
         .DoCmd.TransferText acImportDelim, "Lns_Spec", "Invalid_Lns", invdr, True 
        End If 
        If mist = True Then 
         .DoCmd.TransferText acImportDelim, "Lns_Spec", "Missing_Lns", misdr, True 
        End If 
        .Quit 
       End With 
       Set db = Nothing 
      End If 
      If invt = True Then 
       Set db = CreateObject("Access.Application") 
       dbfn = "C:\Documents and Settings\U299482\Desktop\Databases\CORE IDP.accdb" 
       With db 
        .OpenCurrentDatabase dbfn, True 
        .Visible = True 
        **CurrentDb.Execute "A0_Empty_ERLMF_InvalidLoans_2013-04-02", dbFailOnError** 
        .DoCmd.TransferText acImportDelim, "Lns_Spec", "ERLMF_InvalidLoans_2013-04-02", invdr, True 
        CurrentDb.Execute "AppendERLMF", dbFailOnError 
        CurrentDb.Execute "FaxRF Crystal Append", dbFailOnError 
        .Quit 
       End With 
       Set db = Nothing 
      End If 
      Item.UnRead = False 
     End If 
    Next 
End If 

End Sub 

Answer 1

我認爲你正在重疊.Execute命令。您需要確保第一次執行完成後才能開始下一次。要解決這個問題，我首先聲明一個公共變量Executing，然後將下面的代碼移到它自己的方法中。

Sub Execute() 

    Executing = True 

    Set db = CreateObject("Access.Application") 
    dbfn = "C:\Documents and Settings\U299482\Desktop\Databases\CORE IDP.accdb" 
    With db 
    .OpenCurrentDatabase dbfn, True 
    .Visible = True 
    CurrentDb.Execute "A0_Empty_ERLMF_InvalidLoans_2013-04-02", dbFailOnError 
    .DoCmd.TransferText acImportDelim, "Lns_Spec", "ERLMF_InvalidLoans_2013-04-02", invdr, True 
    CurrentDb.Execute "AppendERLMF", dbFailOnError 
    CurrentDb.Execute "FaxRF Crystal Append", dbFailOnError 
    .Quit 
    End With 
    Set db = Nothing 

    Executing = False 

End Sub 

然後，調用函數時，圍繞着它有一個循環，測試，看看是否Executing是假的。

Do 
    If Executing = False Then 
    Execute 
    Exit Do 
    End If 
Loop