VBA: Loop is not working to Navigate Url.

[ssingh75]

Hi All,

I am using below code to navigate the URL and download the data from web. But it is working for only one time for ie2 not in loop..


Private Sub CommandButton1_click()
Dim strTempName As String
Dim strUser, strPass As String
Dim strURL, strURL1, Strhtml As String
Dim iDays, i, iRow, iCol, iSheets As Integer
Dim l, lRow, lCol, lSheets, lText As Long
Dim iData1, iData2, iDAta3 As Integer
Dim strWindow1, strWindow2, strWindow3 As String
Dim ie, ie2, Shell, objWSHShell, objCollection, objElement As Object
Dim ie1 As SHDocVw.InternetExplorer
Dim htmlInput As MSHTML.HTMLInputElement
Dim htmlColl As MSHTML.IHTMLElementCollection
Dim objTag As IHTMLElement
Dim strName As String
Dim strActivity, strSubActivity As String
Dim iSelect1, iSelect2 As Integer
Dim strData As String
Dim strAdd1, strAdd2, strAdd3, strAdd4 As String
On Error Resume Next

strTempName = ActiveWorkbook.Name
iDays = Trim(Range("D1").Value)
Set Shell = CreateObject("Shell.Application")
Set ie = CreateObject("InternetExplorer.Application")
Set ie2 = CreateObject("InternetExplorer.Application")
' Set objWSHShell = WScript.CreateObject("WScript.Shell")

'****Add new workbook to populate the data

Call NewWb

strData = ActiveWorkbook.Name

'Assign User and password for login
Windows.Item(strTempName).Activate
Sheets(1).Activate
'Clear existing data
Range("A2:B1000").Select
Selection.ClearContents
Range("A1").Select

'Select Id and pass

strURL = "Computer Age Management Services"


' UserForm1.WebBrowser1.navigate strURL
ie.navigate strURL

While ie.readyState = READYSTATE_LOADING
delay 2.5
Wend

' apiShowWindow ie.hwnd, SW_MAXIMIZE

Do While ie2.Busy = True
DoEvents
Loop


delay 2.5

'Navigate URL to capture the scheme URL
Strhtml = ie.document.DocumentElement.innerHTML
bunch = GetText2(Strhtml, "<TBODY>", "</TBODY>")
i = InStr(bunch, "</TR>")
For iRow = 0 To i
bunch1 = Trim(Replace(Split(bunch, "</TR>")(iRow), ",", ""))

'Get Scheme

bunch2 = Trim(Replace(Split(bunch1, "<TD>")(1), ",", ""))
bunch3 = Trim(Replace(Split(bunch2, "</TD>")(0), ",", "")) 'Scheme Name

'Get URL

bunch4 = Trim(Replace(Split(bunch1, "</A>")(0), ",", ""))
bunch5 = Trim(Replace(Split(bunch4, "href=")(1), ",", ""))
bunch6 = Trim(Replace(Split(bunch5, ">")(0), ",", ""))
bunch7 = Replace(bunch6, """", "")
bunch8 = "http://www.camsonline.com/InvestorServices/" & bunch7 'NAV URL
bunch9 = Replace(bunch8, "&strnav=", "")
iCol = Application.WorksheetFunction.CountA(Range("A:A"))

iSheets = iCol + 1

'Populate Scheme Name
Range("A" & iSheets).Formula = Trim(bunch3)
Range("B" & iSheets).Formula = Trim(bunch9)

Next
Range("A:B").Select
Selection.RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo

ie.Quit

l = Application.WorksheetFunction.CountA(Range("B:B"))
Range("B1").Select
For lRow = 1 To l

strURL = Trim(ActiveCell.Offset(lRow, 0).Text)

ie2.navigate strURL
delay 2

While ie2.readyState = READYSTATE_LOADING
delay 2.5
Wend
lCol = 1

Do While ie2.Busy = True
DoEvents
Loop

apiShowWindow ie2.hwnd, SW_MAXIMIZE

delay 5



For lCol = 1 To iDays
Set objCollection = ie2.document.getElementsByTagName("input")
For lText = 0 To objCollection.Length
If objCollection(lText).Name = "sch_date" Then

' Set text for search
objCollection(lText).Value = lCol

Else
' If objCollection(lText).Type = "submit" And _
objCollection(lText).Name = "" Then
If objCollection(lText).Type = "submit" Then
' "Search" button is found
Set objElement = objCollection(lText)

End If
End If
Next

objElement.Click


While ie2.readyState = READYSTATE_LOADING
delay 2.5
Wend


Do While ie2.Busy = True
DoEvents
Loop

delay 2

'Strhtml = ie2.document.DocumentElement.innerHTML
' Strhtml = ie2.document.all("divLatestNav").innerText

' iData1 = InStr(Strhtml, "<strong>")
' For iData2 = 0 To iData1
' bunch = Trim(Replace(Split(Strhtml, "<strong>")(iData2), ",", ""))
'
' Next
'
' ie2.ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT
' ie2.ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT
'
' Windows.Item(strTempName).Activate


Strhtml = ie2.document.all("divLatestNav").innerText
bunch = Strhtml
For iData2 = 1 To 100000
bunch1 = Trim(Replace(Split(bunch, " ")(iData2), ",", ""))
bunch2 = Trim(Replace(bunch1, "days ago ", ""))
bunch3 = Trim(Replace(bunch2, "SchemeLast NAV DateNAVChangeReturns", ""))
If bunch3 <> "" Then
Windows.Item(strData).Activate
iData1 = Application.WorksheetFunction.CountA(Range("A:A"))
iData1 = Application.WorksheetFunction.CountA(Sheets(1).Range("A:A"))
Sheets(1).Range("A" & iData1 + 1).Activate
ActiveCell.Value = Application.WorksheetFunction.Clean(Trim(bunch3))
strAdd1 = ActiveCell.Address
strAdd2 = Trim(Replace(Split(ActiveCell.Address, "$")(2), ",", ""))

'**************Populate formulas to get Schemes, Nav and all data*****************
'*******Get data for Schemes
ActiveCell.Offset(0, 1).Formula = _
"=ClEAN(LEFT(A" & strAdd2 & ",LEN(A" & strAdd2 & ")-LEN(TRIM(RIGHT(SUBSTITUTE(A" & strAdd2 & ",""-"",REPT("" "",200)),200)))-7))"

'********Get Data for NAV's Date
ActiveCell.Offset(0, 2).Formula = _
"=CLEAN(1*MID(A" & strAdd2 & ",LEN(A" & strAdd2 & ")-LEN(TRIM(RIGHT(SUBSTITUTE(A" & strAdd2 & ",""-"",REPT("" "",200)),200)))-6,11))"
' ActiveCell.Offset(0, 2).NumberFormat = "dd-mmm-yyyy"

'*********Get Data for NAV's
ActiveCell.Offset(0, 3).Formula = _
"=CLEAN(1*TRIM(LEFT(RIGHT(SUBSTITUTE("" ""&A" & strAdd2 & ","" "",REPT("" "",200)),400),200)))"

'*************Get Changes*************
ActiveCell.Offset(0, 4).Formula = "=CLEAN(1*TRIM(RIGHT(SUBSTITUTE(A" & strAdd2 & ","" "",REPT("" "",200)),200)))"
ElseIf bunch3 = "" Then
Exit For
End If

Next
Cells.Select
Selection.AutoFit
Sheets(1).Range("A1").Select

ie2.Activate

' While ie2.readyState = READYSTATE_LOADING
' delay 2.5
' Wend

delay 1

' lCol = lCol + 1
Next
ie2.Quit
Windows.Item(strTempName).Activate
Sheets(1).Activate
Set ie2 = Nothing

Next

End Sub