Data pull from IE Stalling in Win 7

[jrenton7]

Hi all and thank you in advance for your help or advice. I am still a novice when it comes to writing advanced modules in VBA, and usually I barrow what I can from current reporting to try and find what i need, or edit recorded code. My current issue is with a specific code written by a former co-worker to pull data out of intranet web source into a data sheet in Excel. The issue is that it was written when my company was using Office 2003 and Windows XP. Now I am using windows 7 Office 2010, and it is stalling whenever I attempt to run the module in VBA. One major note is the intranet website that the data is pulling from required the following Network security parameters unchecked DES_CBC_MD5 and RC4_HMAC_MD5 before data was viewable on the website.

The current macro with "XXXX" being the data website being pulled
[VBA] Sub GetAllReportsData()
'Combined Rateplan, Feature and Activation MRC MTD
GetReportData "XXXX", Worksheets("Raw Data").Range("A2")







End Sub
Sub GetReportData(ByVal sLink As String, ByRef objRange As Range)
'DO NOT CHANGE THIS CODE BELOW
'DO NOT CHANGE THIS CODE BELOW
'DO NOT CHANGE THIS CODE BELOW

' Dim fso As New FileSystemObject
' Dim a As TextStream
Dim y As String



Set IE = CreateObject("INTERNETEXPLORER.APPLICATION")

IE.Visible = True
IE.Navigate sLink
Debug.Print sLink & " -- " & objRange.Address
st = Timer
DoEvents
Do While IE.Busy
DoEvents
Loop



retryit:
On Error Resume Next
y = IE.Document.body.innerHTML
If InStr(y, "reportLabel_") = 0 Then
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 1
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
Debug.Print "RETRYING IT"
y = ""
GoTo retryit
End If

' fso.CreateTextFile ("c:\tmetricsdata" & st & ".txt")
' Set a = fso.OpenTextFile("c:\tmetricsdata" & st & ".txt", ForWriting)
' a.Write y
' a.Close

LeftSideLabels objRange, y
TopLabels objRange, y
DataValues objRange, y



IE.Quit



End Sub



Sub DataValues(ByRef objRange As Range, ByVal sHTMLData As String)
'DO NOT CHANGE THIS CODE BELOW
'DO NOT CHANGE THIS CODE BELOW
'DO NOT CHANGE THIS CODE BELOW



' Dim fso As New FileSystemObject
' Dim objFile As TextStream

For e = 0 To 1000
sSearchString1 = "reportDataCell_" & e
Z = InStr(1, sHTMLData, sSearchString1)
If Z = 0 Then Exit For

For f = 0 To 1000
sSearchString2 = sSearchString1 & "_" & f
Z = InStr(1, sHTMLData, sSearchString2) 'starting point for where the data is located

If Z = 0 Then Exit For

'search for the first occurrance of <NOBR> and for the first occurrance of </NOBR>. Between these is the data value
NOBRStartLoc = InStr(Z, sHTMLData, "<NOBR>") 'starting point for where the data is located
NOBREndLoc = InStr(Z, sHTMLData, "</NOBR>") 'starting point for where the data is located
sDataValue = Mid(sHTMLData, NOBRStartLoc + 6, NOBREndLoc - NOBRStartLoc - 6)

objRange.Offset(e + 1, f + 1).Value = sDataValue
Next f
Next e



End Sub



Sub LeftSideLabels(ByRef objRange As Range, ByVal sHTMLData As String)
'DO NOT CHANGE THIS CODE BELOW
'DO NOT CHANGE THIS CODE BELOW
'DO NOT CHANGE THIS CODE BELOW

' Dim fso As New FileSystemObject
' Dim objFile As TextStream

For a = 0 To 2000
b = InStr(1, sHTMLData, "reportLabel_1_" & a) 'starting point for where the data is located

If b = 0 Then Exit For

c = InStr(b, sHTMLData, "_blank.gif"" width=10 height=10>") 'starting point for where the data is located
d = InStr(c, sHTMLData, "</") 'starting point for where the data is located
lenText = d - c - 31

sDataValue = Mid(sHTMLData, c + 31, lenText)
objRange.Offset(a + 1, 0).Value = sDataValue
Next a

End Sub


Sub TopLabels(ByRef objRange As Range, ByVal sHTMLData As String)
'DO NOT CHANGE THIS CODE BELOW
'DO NOT CHANGE THIS CODE BELOW
'DO NOT CHANGE THIS CODE BELOW



' Dim fso As New FileSystemObject
' Dim objFile As TextStream

For a = 0 To 1000
b = InStr(1, sHTMLData, "reportLabel_0_" & a) 'starting point for where the data is located

If b = 0 Then Exit For

c = InStr(b, sHTMLData, "vAlign=top>") 'starting point for where the data is located
d = InStr(c, sHTMLData, "</") 'starting point for where the data is located
lenText = d - c - 11

sDataValue = Mid(sHTMLData, c + 11, lenText)
sDataValue = Replace(sDataValue, vbCrLf, "") 'Remove any embedded CRLF characters
sDataValue = Replace(sDataValue, "<DIV class=descending>", "") 'Remove garbage
sDataValue = Replace(sDataValue, "<DIV class=ascending>", "") 'Remove garbage
objRange.Offset(0, a + 1).Value = sDataValue
Next a



End Sub


[/VBA]

[Jan Karel Pieterse]

After the code has been running for a while, please stop the code (control+break). Then check the immediate window (in the VA editor press control+g).
I bet there is a whole bunch of "RETRYING IT" entries there, am I right?
In that case, the entry called "reportLabel_" possibly is no longer in the HTML of the page.

[jrenton7]

After the code has been running for a while, please stop the code (control+break). Then check the immediate window (in the VA editor press control+g).
I bet there is a whole bunch of "RETRYING IT" entries there, am I right?
In that case, the entry called "reportLabel_" possibly is no longer in the HTML of the page.

THANK YOU! you are completely correct. Now my issue is what i need to replace to enable it to continue the DL of data. I am getting this error the first time i run it when opening on a win 7 machine "Automation error: The object invoked has disconnected from its clients". I also will say this works fine on a win xp machine with office 2007. Any ideas on how to adjust that piece?

[Jan Karel Pieterse]

Put a break on this line:
If InStr(y, "reportLabel_") = 0 Then
Then you can access the variable y's contents, it contains the html it downloaded.
IN the debug window type ?y and press enter.

[Jan Karel Pieterse]

And of course you can also select View, Source from the IE window to achieve the same...