none
Macro getting error: Run-time error -2147319764 (8002802b) Automation Error - Element not found RRS feed

  • Question

  • Hello,

    I am really stumped on this error.  If someone can explain to me why I am getting this error, I would appreciate it. 

    Using search criteria on a worksheet, the macro is navigate to a webpage and output the results into worksheets, this is done in a loop.  The 1st record, reads 10 pages and output the data for each page.  The macro get run time error on 2nd record.  I have identified the code the cause the error, but I do not know why.  Your expert assistance is truly appreciate.

    Thanks for your help.

    smsemail

    The line of code that says "error" is where the run time error occurs

    -----error--->  RecCount = Application.WorksheetFunction.CountA(Worksheets("QryHold").Range("B:B"))

    For r = 17 To EndRow
                                                                                                                                                      
            Label = Worksheets("RIPS").Cells(r, 1).Value
            
            Debug.Print Label
            
            Worksheets("RIPSSummary").Activate
            Worksheets("RIPSSummary").Range("A" & rSum) = Label
            
            Worksheets("QryHold").Activate
            Worksheets("QryHold").Select
            Selection.ClearContents
       
         
            'Progress Bar
            frm_progress.lbl_progress.Visible = True
            frm_progress.Repaint
            DoEvents
            frm_progress.lbl_progress.Width = x
            frm_progress.Label1.Width = EndRow - (17 - 1)
            frm_progress.lbl_pct.Caption = Format(frm_progress.lbl_progress.Width / (EndRow - (17 - 1)), "0%") & " Complete"
            frm_progress.lbl_label.Caption = "Obtaining RIP results for " & Label
            frm_progress.Repaint
            DoEvents
           
            If SearchType = "Tracking Number" Then
               IE.Visible = False
               Application.Wait (Now + TimeValue("0:00:03"))
               IE.Navigate "https://pts-2.usps.gov/pts2-web/rips?searchType=TrackingNumber&dateRange=AllDates&searchValues=" & Label & "&submitRequest=Submit&savePagination=&hiddenText="
               Do
                 If IE.ReadyState = 4 Then
                    IE.Visible = False
                    Exit Do
                 Else
                    DoEvents
                 End If
               Loop
            End If
            
            If SearchType = "IP Address" Then
                With IE
                  .Visible = True
                  Application.Wait (Now + TimeValue("0:00:03"))
                  .Navigate "https://pts-2.usps.gov/pts2-web/rips?searchType=IpAddress&dateRange=AllDates&partialIpMatch=No&searchValues=" & Label & "submitRequest=Submit&savePagination=searchType%3DTrackingNumber%26dateRange%3DAllDates%26searchValues%3D" & Label & "%26submitRequest%3DSubmit%26savePagination%3D%26hiddenText%3D&hiddenText="
                  Do While .Busy: DoEvents: Loop
                  Do Until .ReadyState = 4: DoEvents: Loop
               End With
            End If
            
            Do While IE.Busy: DoEvents: Loop
            Do Until IE.ReadyState = READYSTATE_COMPLETE: Loop
        
            Do While IE.Busy: DoEvents: Loop
            Do Until IE.ReadyState = READYSTATE_COMPLETE: Loop
            
            While IE.ReadyState <> 4
                  DoEvents
            Wend
            
            Set ieDoc = IE.Document
            Set ieTable = ieDoc.all.Item("ripsResultTable")
     
            If Not ieTable Is Nothing Then
               
               URLPageCount = URLPageCount + 1
               
               RecordFound = True
               
               'Move data to QryHold
               Set Clip = New DataObject
               Clip.SetText "<html>" & ieTable.outerHTML & "</html>"
               Clip.PutInClipboard
               Worksheets("QryHold").Range("A1").Select
               Worksheets("QryHold").PasteSpecial "Unicode Text"
               If Application.WorksheetFunction.CountA(Worksheets("QryHold").Range("B:B")) < 1 Then GoTo NextLabel:
               RecCount = Application.WorksheetFunction.CountA(Worksheets("QryHold").Range("B:B"))
                        
               If SearchType = "Tracking Number" Then
                  'Initialize variables
                  r2 = 1
                  DetCount = RecCount
                  NextPage = True
            
                  'Loop thru the rest of the web pages of IP address
                  Do Until NextPage = False
                     'Check for Next page
                     Set HTMLDoc = IE.Document
                     
                     If 0 = InStr(1, HTMLDoc.body.innerText, "Next") Then
                        NextPage = False
                        Exit Do
                     End If
               
                     r2 = (r2 + 1)
                  
                     Call GetURL
               
                     If URLString1 = "" Then
                        NextPage = False
                        Exit Do
                     End If
               
                     'Navigate to url
                     Application.Wait (Now + TimeValue("0:00:05"))
                     IE.Navigate "https://pts-2.usps.gov" & URLString1
                  
                     Do While IE.Busy: DoEvents: Loop
                     Do While IE.Busy: DoEvents: Loop
                  
                     Do
                       If IE.ReadyState = 4 Then
                          IE.Visible = False
                          Exit Do
                       Else
                          DoEvents
                       End If
                     Loop
                  
                     Set ieDoc = IE.Document
                     Set ieTable = ieDoc.all.Item("ripsResultTable")
        
                     If Not ieTable Is Nothing Then
                        Worksheets("QryHold").Activate
                        'Move data to RipsDetail
                        Set Clip = New DataObject
                        Clip.SetText "<html>" & ieTable.outerHTML & "</html>"
                        Clip.PutInClipboard
                        Worksheets("QryHold").Range("A" & (DetCount + 1)).Select
                        Worksheets("QryHold").PasteSpecial "Unicode Text"
     ----- ERROR-->     RecCount = Application.WorksheetFunction.CountA(Worksheets("QryHold").Range("B:B"))
                        NextPage = False
                        Exit Do
                     End If
                     Debug.Print "reset objects"
                     'reset objects
                     Set ieDoc = Nothing
                     Set ieTable = Nothing
                     Set Clip = Nothing
                  Loop
                
               End If
            Else
               RecordFound = False
            End If
            
            Worksheets("QryHold").Activate
            
            If RecordFound = False Then
               Worksheets("RIPS").Range("B" & r) = ""
               Worksheets("RIPS").Range("C" & r) = ""
               Worksheets("RIPS").Range("D" & r) = ""
               Worksheets("RIPS").Range("E" & r) = ""
               GoTo NextLabel:
            End If
                 
             'delete column headers except first row column header
            For r2 = 2 To RecCount
                 If r2 > 1 Then
                    If InStr(1, Worksheets("QryHold").Range("B" & r2), "Tracking") > 0 Then
                       Rows(r2).Delete
                    End If
                 End If
            Next r2
                 
            'Tracking Control Count
            Worksheets("RIPS").Range("B" & r) = (Application.WorksheetFunction.CountA(Worksheets("QryHold").Range("B:B")) - 1)
            
            'Network 56 count
            Network56Cnt = 0
            For RW = 2 To (RecCount - 1)
                If Mid(Worksheets("QryHold").Cells(RW, 3), 1, 2) = "56" Then
                   Network56Cnt = (Network56Cnt + 1)
                End If
            Next RW
            Worksheets("RIPS").Range("C" & r) = Network56Cnt
            
            'Network 170 count
            Network170Cnt = 0
            For RW = 2 To (RecCount)
                If Mid(Worksheets("QryHold").Cells(RW, 3), 1, 3) = "170" Then
                   Network170Cnt = (Network170Cnt + 1)
                End If
            Next RW
            Worksheets("RIPS").Range("D" & r) = Network170Cnt
            
            'Unique IP count
             Worksheets("RIPS").Range("E" & r) = CountUnique(Worksheets("QryHold").Range("C2:C" & (RecCount)))
             
            'Add hyperlink
            Worksheets("RIPS").Hyperlinks.Add Anchor:=Worksheets("RIPS").Range("A" & r), Address:=""
             
            'Add worksheet with Label Name and copy data from QryHold and format
            Worksheets.Add.Name = Label
            Worksheets("QryHold").Activate
            Worksheets("QryHold").Range("B1:H" & RecCount).Select
            Selection.Copy
            Worksheets(Label).Activate
            Worksheets(Label).Select
            ActiveSheet.Paste
            
            Call FormatWorkSheet
            
            'Populate RIPSSummary worksheet
            Worksheets("RIPSSummary").Activate
            Worksheets("RIPSSummary").Range("B" & rSum) = (Application.WorksheetFunction.CountA(Worksheets("QryHold").Range("B:B")) - 1)
            Worksheets("RIPSSummary").Range("C" & rSum) = Network56Cnt
            Worksheets("RIPSSummary").Range("D" & rSum) = Network170Cnt
            Worksheets("RIPSSummary").Range("E" & rSum) = CountUnique(Worksheets("QryHold").Range("C2:C" & (RecCount)))
          
    NextLabel:
            Debug.Print "Next Label"
            rSum = rSum + 1
            x = x + 1
        Next r


    • Edited by smsemail Tuesday, February 10, 2015 2:48 PM
    Tuesday, February 10, 2015 2:44 PM

All replies

  • Hi smsemail,

    I made a simple test with the code, and it worked correctly.

                        Worksheets("QryHold").Activate
                        'Move data to RipsDetail
                        Set Clip = New DataObject
                        Clip.SetText "<html>" & ieTable.outerHTML & "</html>"
                        Clip.PutInClipboard
                        Worksheets("QryHold").Range("A" & (DetCount + 1)).Select
                        Worksheets("QryHold").PasteSpecial "Unicode Text"
     RecCount = Application.WorksheetFunction.CountA(Worksheets("QryHold").Range("B:B"))

    >>The 1st record, reads 10 pages and output the data for each page.  The macro get run time error on 2nd record.

    Could you share the what the 1st and 2nd record are? I am wondering what the record and the pages are?

    Based on your description, the 1st record is correct and the 2nd record run into wrong. I think you could change the order of the record. Also, you could compare the 1st record and the 2nd record to see the difference of them.

    I made a simple test with the code, and it worked correctly

    Best Regards,

    Leo

    Wednesday, February 11, 2015 11:44 AM
  • Hi smsemail,

    I could not reproduce your issue, and I suspect this issue may be related to a specific spreadsheet. It would be helpful if you could share us a sample spreadsheet through the OneDrive to help us reproduce this issue.

    Best Regards,

    Edward


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.


    Friday, February 13, 2015 2:42 AM