0

所以我在 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
4

1 回答 1

0

我认为你得到了重叠的.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
于 2013-10-28T19:20:15.760 回答