jeudi 24 juin 2021

VBA - Connect macro for scraping web

I am new to the site and looking for some help.

I am creating in VBA a scraping macro to log in to a website, navigate to a search page, input the search data and return the values.

I have managed to create the macros for each step individually. however, its look like I am not able to joining them. Anyone can help out?

Step 1 - create an instance and log in.

Sub Login()

Dim i As SHDocVw.InternetExplorer
    
Set i = New InternetExplorer

    
i.navigate "https://www.test.com"


Do While i.readyState <> READYSTATE_COMPLETE

Loop


Dim idoc As MSHTML.HTMLDocument
Set idoc = i.document

x = InputBox("Enter Redbook Password", "Password Required")

idoc.all.txtCompany.Value = ThisWorkbook.Sheets("Parameter").Range("B4")
idoc.all.txtUserName.Value = ThisWorkbook.Sheets("Parameter").Range("B5")
idoc.all.txtPassword.Value = x

i.Visible = True

Set eles = idoc.getElementsByName("butLogon")


For Each ele In eles

If ele.Name = "butLogon" Then
    ele.Click
    Else
End If
Next ele

End Sub

Step 2: on ie active the current tab the same page that just log in, navigate to another link in the website


Sub Gotobroswer()
On Error Resume Next
Set objShell = CreateObject("Shell.Application")
IntWinCnt = objShell.Windows.Count


For intWinNo = 0 To (IntWinCnt - 1)
  strWinTitle = objShell.Windows(intWinNo).document.Title
    If strWinTitle = "search" Then
    Set i = objShell.Windows(intWinNo)
    Exit For
    End If
Next


i.navigate "https://www.testserach.com"


  End Sub

Step 3 on the same activated page I input data in the specific field and hit search

   Sub Searchcode()
   On Error Resume Next
   Set objShell = CreateObject("Shell.Application")
   IntWinCnt = objShell.Windows.Count

   For intWinNo = 0 To (IntWinCnt - 1)
   strWinTitle = objShell.Windows(intWinNo).document.Title
    If strWinTitle = "Name" Then
    Set i = objShell.Windows(intWinNo).document
    Exit For
    End If
    Next
    i.all.vehkey.Value = "AUV457" 
 
    Set eles = i.getElementsByName("Go")

    For Each ele In eles

    If ele.Name = "Go" Then
        ele.Click
        Exit For
    End If
    Next ele


    End Sub

Step 4 Browse on the result page to land on a specific link URL within the search

Sub GotoPirceAhead()
On Error Resume Next
Set objShell = CreateObject("Shell.Application")
IntWinCnt = objShell.Windows.Count

For intWinNo = 0 To (IntWinCnt - 1)
  strWinTitle = objShell.Windows(intWinNo).document.Title
    If strWinTitle = "result" Then
    Set i = objShell.Windows(intWinNo).document
    
    Exit For
    End If
Next

Set AllHyperlinks = i.getElementsByTagName("a")

For Each Hyper_Links In AllHyperlinks

    If Hyper_Links.innerText = "Price Ahead" Then
        Hyper_Links.Click
        Exit For
    End If
Next Hyper_Links


End Sub

Step 5 Retrieve the data and enter them in excel

Sub RetrieveDatapirceAheadDataTab()
'Go to Hyperlink


On Error Resume Next
Set objShell = CreateObject("Shell.Application")
IntWinCnt = objShell.Windows.Count

For intWinNo = 0 To (IntWinCnt - 1)
  strWinTitle = objShell.Windows(intWinNo).document.Title
    If strWinTitle = "Result" Then
    Set i = objShell.Windows(intWinNo).document
    Exit For
    End If
Next

Set mtbl = i.getElementsByTagName("Table")(2)
Set table_data = mtbl.getElementsByTagName("tr")
Set mtbl3 = i.getElementsByTagName("Tbody")(2)
Set Description = mtbl3.getElementsByTagName("td")

 itemNum = 8
    For childNum = 0 To 20
        Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, childNum + 7) = table_data.Item(itemNum).Children(childNum).innerText
    Next childNum

 itemNum = 9
    For childNum = 0 To 20
        Cells(Cells(Rows.Count, 1).End(xlUp).Row + 2, childNum + 7) = table_data.Item(itemNum).Children(childNum).innerText
        
    Next childNum

itemNum = 10
    For childNum = 0 To 20
        Cells(Cells(Rows.Count, 1).End(xlUp).Row + 3, childNum + 7) = table_data.Item(itemNum).Children(childNum).innerText
    Next childNum
    
itemNum = 11
    For childNum = 0 To 20
        Cells(Cells(Rows.Count, 1).End(xlUp).Row + 4, childNum + 7) = table_data.Item(itemNum).Children(childNum).innerText
    Next childNum
    
itemNum = 12
    For childNum = 0 To 20
        Cells(Cells(Rows.Count, 1).End(xlUp).Row + 5, childNum + 7) = table_data.Item(itemNum).Children(childNum).innerText
    Next childNum

    
itemNum = 2
    For childNum = 1 To 1
        Cells(Cells(Rows.Count, 1).End(xlUp).Row + 5, 1) = Description.Item(itemNum).Children(childNum).innerText
    Next childNum


End Sub

after step 5 I want to loop back in step2 and execute again for all the search value (value for step 3). assuming that the search value is a list in excel starting from A1 down to A200

thanks anyone for the help




Aucun commentaire:

Enregistrer un commentaire