VBA从Lotus Notes下载文件

Question

我试图从某些Lotus Notes电子邮件下载附件。下面的代码可以工作，但在保存所有必需文件后，它会进入无限循环（代码执行永远不会在程序之后结束）。在我猜之前，Do有什么问题。在解决这个问题上会有一些帮助。

    Sub Test2Dobre()
        Dim sess As Object
        Dim db As Object
        Dim view As Object
        Dim doc As Object
        Dim docNext As Object
        Dim mailServer As String
        Dim mailFile As String
        Dim fld1 As String
        Dim strSQL As String

        Const stPath As String = "C:\Users\kuckam\Desktop\test notes\"
        Const EMBED_ATTACHMENT As Long = 1454
        Const RICHTEXT As Long = 1
        Dim vaItem As Variant
        Dim vaAttachment As Variant

        Set sess = CreateObject("Notes.NotesSession")
        'Call sess.Initialize(Password)

        Dim objADOConnection As Object
        Set objADOConnection = CreateObject("ADODB.Connection")

        'to get your mail db:
        mailServer = sess.GetEnvironmentString("MailServer", True)
        mailFile = sess.GetEnvironmentString("MailFile", True)
        Set db = sess.GetDatabase(mailServer, mailFile)

        'Get Inbox folder:
        Set view = db.GetView("($Inbox)")

        'Loop through all documents in Inbox:
        Set doc = view.GetFirstDocument

        Do Until doc Is Nothing
            Set docNext = view.GetNextDocument(doc)
            If doc.HasEmbedded And doc.GetItemValue("From")(0) = "<Protokoly.warszawa@linde-mh.pl>" Then
                MsgBox doc.GetItemValue("subject")(0)
                'MsgBox doc.GetItemValue("From")(0)

                'Check if the document has an attachment or not.
                Set vaItem = doc.GetFirstItem("Body")
                If vaItem.Type = RICHTEXT Then
                    For Each vaAttachment In vaItem.EmbeddedObjects
                        If vaAttachment.Type = EMBED_ATTACHMENT Then
                            'Save the attached file into the new folder and remove it from the e-mail.
                            With vaAttachment
                                .ExtractFile stPath & vaAttachment.Name
                                ' .Remove
                            End With
                        End If
                    Next vaAttachment
                End If
            End If        
            Set doc = docNext
        Loop
    End Sub

EDIT: 
Posting working code:

      Function ADOExecSQL(strSQL As String)
          ADOExecSQL = 1
          On Error GoTo ERROR_FUNCTION
          If ADODbConnect() = 0 Then GoTo ERROR_FUNCTION
          cnConn.Execute strSQL
    EXIT_FUNCTION:
          Exit Function
    ERROR_FUNCTION:
          ADOExecSQL = 0
          GoTo EXIT_FUNCTION
    End Function
      Sub Test2Dobre()

      Dim sess As Object
          Dim db As Object
          Dim view As Object
          Dim doc As Object
          Dim docNext As Object
          Dim mailServer As String
          Dim mailFile As String
          Dim fld1 As String
          Dim strSQL As String


    Const stPath As String = "C:\Users\kuckam\Desktop\test notes\"
    Const EMBED_ATTACHMENT As Long = 1454
    Const RICHTEXT As Long = 1
    Dim vaItem As Variant
    Dim vaAttachment As Variant


    Set sess = CreateObject("Notes.NotesSession")
          'Call sess.Initialize(Password)

          Dim objADOConnection As Object
          Set objADOConnection = CreateObject("ADODB.Connection")

    'to get your mail db:
          mailServer = sess.GetEnvironmentString("MailServer", True)
          mailFile = sess.GetEnvironmentString("MailFile", True)
          Set db = sess.GetDatabase(mailServer, mailFile)

    'Get Inbox folder:
          Set view = db.GetView("($Inbox)")
          view.AutoUpdate = False

    'Loop through all documents in Inbox:

          Set doc = view.GetFirstDocument


          Do Until doc Is Nothing
          Set docNext = view.GetNextDocument(doc)

            'If doc.HasEmbedded And doc.GetItemValue("From")(0) = "<Protokoly.warszawa@linde-mh.pl>" Then
            'If doc.GetItemValue("From")(0) = "<Protokoly.warszawa@linde-mh.pl>" Then

            'MsgBox doc.GetItemValue("subject")(0)
            'MsgBox doc.GetItemValue("From")(0)




    'Check if the document has an attachment or not.

    Set vaItem = doc.GetFirstItem("Body")
    On Error GoTo Line1
    If vaItem.Type = RICHTEXT And doc.GetItemValue("From")(0) = "<Protokoly.warszawa@linde-mh.pl>" Then
    For Each vaAttachment In vaItem.EmbeddedObjects
    If vaAttachment.Type = EMBED_ATTACHMENT Then
    'Save the attached file into the new folder and remove it from the e-mail.
    With vaAttachment
    .ExtractFile stPath & vaAttachment.Name
    ' .Remove

    End With
    End If
    'Save the e-mail in order to reflect the deleting of the attached file.
    '(A more sophisticated approach may be considered if several e-mails have
    'several attachments in order to avoid a repeately saving of one e-mail.)
    doc.Save True, False
    Next vaAttachment
    End If
    'End If


    'Call Attachment.ExtractFile("C:\Users\kuckam\Desktop\test notes")


        'Call doc.PutInFolder("C:\Users\kuckam\Desktop\test notes")



    Set doc = docNext

    Loop

    'Release objects from memory.
    Set docNext = Nothing
    Set doc = Nothing
    Set view = Nothing
    Set sess = Nothing
    Set db = Nothing
    Set objADOConnection = Nothing
    Set vaItem = Nothing

    Line1:
    End Sub