none
I am getting error ehile running macro in Win7\IE 8.URGENt -Help needed to fix it. RRS feed

  • Question

  • I am getting the following Error while running this MACRO:

    Run-time error '-2147023179(800706b5)

    Automation error
    The interface is unknow

    Code :

    'Option Explicit
    Sub sample()
    Dim i As Integer
    Dim htmlDoc As HTMLDocument
    Dim htmlInput As HTMLInputElement
    Dim htmlColl As IHTMLElementCollection
    For i = 2 To Sheet1.UsedRange.Rows.Count

    Dim IE As New InternetExplorer
    IE.Visible = True
    IE.navigate " source link"
    Do
    DoEvents
    Loop Until IE.readyState = READYSTATE_COMPLETE
    Dim doc As HTMLDocument
    Set doc = IE.document
    Dim txt1 As String
    txt1 = "2"
       newHour = Hour(Now())
       newMinute = Minute(Now())
       newSecond = Second(Now()) + 2
    doc.getElementById("problemId").Value = Sheet1.Range("E" & i).Value
    Set htmlDoc = IE.document
    Set htmlColl = htmlDoc.getElementsByTagName("input")
    For Each htmlInput In htmlColl
        If Trim(htmlInput.Value) = "Find" Then
            htmlInput.Click
            Exit For
        End If
    Next htmlInput
    'doc.getElementsByTagName("INPUT").Item("h_shortDesc").Value = "fssfd"
    'doc.getElementById("severity").Value = "2"
    'doc.getElementById("problemType").Value = "3"
    'doc.getElementById("recurrence").Value = "1"

    'doc.getElementById("foundPhase").Value = "Certification"
    'doc.getElementById("delId").Value = "66"
    'doc.Links("mAdditionalTextBtn", 0).Click
    'doc.getElementsByTagName("textarea").Item("addtext").Value = "addtext"

     


    'For Each htmlInput In htmlColl
     '   If Trim(htmlInput.Value) = "Create WebTeam" Then
      '      htmlInput.Click
       '     Exit For
       ' End If
    'Next htmlInput
       newHour = Hour(Now())
       newMinute = Minute(Now())
       newSecond = Second(Now()) + 3
       waitTime = TimeSerial(newHour, newMinute, newSecond)
       Application.Wait waitTime
      Dim sta As String
    sta = doc.getElementById("status").Value
    If sta = 66 Then
    Sheet1.Range("G" & i).Value = "Entered"
    ElseIf sta = 67 Then
    Sheet1.Range("G" & i).Value = "Assigned"
    ElseIf sta = 75 Then
    Sheet1.Range("G" & i).Value = "Bogus"
    ElseIf sta = 81 Then
    Sheet1.Range("G" & i).Value = "Checkout"
    ElseIf sta = 65 Then
    Sheet1.Range("G" & i).Value = "Closed"
    ElseIf sta = 68 Then
    Sheet1.Range("G" & i).Value = "Closed as Duplicate"
    ElseIf sta = 9 Then
    Sheet1.Range("G" & i).Value = "Deferred"
    ElseIf sta = 64 Then
    Sheet1.Range("G" & i).Value = "Failed"
    ElseIf sta = 80 Then
    Sheet1.Range("G" & i).Value = "Non-Issue"
    ElseIf sta = 62 Then
    Sheet1.Range("G" & i).Value = "Pending"
    ElseIf sta = 61 Then
    Sheet1.Range("G" & i).Value = "Resolving"
    ElseIf sta = 63 Then
    Sheet1.Range("G" & i).Value = "Validation"
    ElseIf sta = 82 Then
    Sheet1.Range("G" & i).Value = "Waiting"
    End If
    'doc.getElementsByTagName("INPUT").Item("projectID").Value = 100008610
    'Set htmlDoc = IE.document
    'Set htmlColl = htmlDoc.getElementsByTagName("input")
    'For Each htmlInput In htmlColl
    '    If Trim(htmlInput.Value) = "Update WebTeam" Then
    '        htmlInput.Click
    '        Exit For
    '    End If
    'Next htmlInput

    doc.Close
    Next
    MsgBox "Webteam status updated succesfully"
    'doc.getElementById("problemId").Value
    End Sub

    Sub getwebteam()
    errhandler:
     
       newHour = Hour(Now())
       newMinute = Minute(Now())
       newSecond = Second(Now()) + 3
       waitTime = TimeSerial(newHour, newMinute, newSecond)
       Application.Wait waitTime
    SendKeys "{TAB}", True
    SendKeys "{TAB}", True
    SendKeys "{TAB}", True
    SendKeys "{TAB}", True
    SendKeys "{TAB}", True
    SendKeys "{TAB}", True
    SendKeys "{TAB}", True
    SendKeys "{TAB}", True
    SendKeys "{TAB}", True
    SendKeys "{TAB}", True
    SendKeys "{TAB}", True
    SendKeys "{TAB}", True
    SendKeys "{TAB}", True
    SendKeys "{TAB}", True
    SendKeys "{TAB}", True
    SendKeys "~", True
       newHour = Hour(Now())
       newMinute = Minute(Now())
       newSecond = Second(Now()) + 5
       waitTime = TimeSerial(newHour, newMinute, newSecond)
       Application.Wait waitTime

    End Sub

    • Moved by George Hua Tuesday, June 17, 2014 6:32 AM not related to Office
    Monday, June 16, 2014 11:38 AM

All replies

  • Hello,

    Did you try to debug the code? What line of code exactly generates the error?

    Where do you run that code? How is it related to Outlook?
    Monday, June 16, 2014 11:49 AM
  • It is showing error in below line:

    Loop Until IE.readyState = READYSTATE_COMPLETE

    Actually it is not outlook. its a webpage where we can enter our defect ID and get status of it. That web page link i could not share


    in line (IE.navigate " source link") that link will come.
    • Edited by stalin1107 Monday, June 16, 2014 12:02 PM
    Monday, June 16, 2014 12:00 PM
  • Hello,

    It looks like the issue is not related to Outlook at all. That's why I'd recommend asking IE related questions in the Internet Explorer Extension Development  forum instead.

    Monday, June 16, 2014 12:23 PM
  • Hi stalin,

    >>It is showing error in below line: Loop Until IE.readyState = READYSTATE_COMPLETE<<

    I made a test for you in Windows 7 and IE8, the sample below works fine:

    Sub test()
        Dim IE As New InternetExplorer
        IE.Visible = True
        IE.navigate "www.msdn.com"
        Do
        DoEvents
        Loop Until IE.readyState = READYSTATE_COMPLETE
    '    Dim doc As HTMLDocument
        Set doc = IE.Document
    End Sub
    If the sample also works for you, I think the issue is related to the website. Can you access the website through IE browser?

    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.

    Tuesday, June 17, 2014 6:31 AM