Crawler & Scraper using excel vba - vba

I am trying to crawl in an intranet URL, so I can get the excel automatically select one of the options from a dropdown menu, then enter a value in a text box, then click on Find to get redirected to another page, where I want to get a value copy to another worksheet in the same workbook, I have created the below, but the code is not working, saying object required. :(
Sub Test()
Dim rng As Range
Set rng = Sheets("sheet1").Range("A1", Sheets("sheet1").Cells.Range("A1").End(xlDown))
Set ie = CreateObject("InternetExplorer.application")
ie.Visible = True
ie.Navigate ("https://gcd.ad.plc.cwintra.com/GCD_live/login/login.asp")
Do
If ie.ReadyState = 4 Then
ie.Visible = False
Exit Do
Else
DoEvents
End If
Loop
ie.Document.forms(0).all("txtUsername").Value = ""
ie.Document.forms(0).all("txtPassword").Value = ""
ie.Document.forms(0).submit
ie.Visible = True
Appliction.Wait (Now + TimeValue("00:00:02"))
DoEvents
For Each cell In rng
ie.Navigate ("https://gcd.ad.plc.cwintra.com/GCD_live/search.asp")
DoEvents
ie.Document.getElementById("cboFieldName").selectedIndex = 6
ie.Document.getElementById("txtFieldValue").Select
SendKeys (cell.Value)
DoEvents
ie.Document.getElementById("cmdFind").Click
Next cell
End Sub

Related

Why isn't the VBA google search not looking up all the cells in the column?

Hi I'm trying to get VBA to run a script to bring back all the links from the first page after running a google search, but it doesn't consistently search all the cells in the column.
Also can anyone help me get the hyperlinks and innertext separate? Here's a copy of the code below:
'Start the bot called SearchBot
Sub SearchBot()
'declare/set aside memory for our variables
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ActiveWorkbook
Set ws = ActiveSheet
For h = 1 To ws.Range("A1").CurrentRegion.Rows.Count
Dim objIE As Object
Dim aEIe As HTMLLinkElement
Dim y As Integer
Dim result As String
'Start Internet Explorer
Set objIE = New InternetExplorer
'Make Internet Explorer Visible
objIE.Visible = True
'navigate to the google webpage
objIE.navigate "google.com"
'Wait for a few seconds while the browser is busy
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
'in the search box enter the field from the cell and press search
objIE.document.getElementsByName("q")(0).Value = ws.Cells(h, 1).Value
SendKeys "{Enter}"
'Wait again for the browser to finish
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
ws.Cells(h, 2).Select
x = 0
For Each aEIe In objIE.document.getElementsByClassName("r")
ActiveCell = objIE.document.getElementsByClassName("r")(x).innerText
ActiveCell.Offset(0, 1).Select
x = x + 1
Next
objIE.Quit
Next
End Sub

VBA to find text from webpages

I have created Macro which gives me all URLs present on any webpages.
We just need to provide the URL and it gives us the all links present in that webpage and paste it in one column
Private Sub CommandButton4_Click()
'We refer to an active copy of Internet Explorer
Dim ie As InternetExplorer
'code to refer to the HTML document returned
Dim html As HTMLDocument
Dim ElementCol As Object
Dim Link As Object
Dim erow As Long
Application.ScreenUpdating = False
'open Internet Explorer and go to website
Set ie = New InternetExplorer
ie.Visible = True
ie.navigate Cells(1, 1)
'Wait until IE is done loading page
Do While ie.READYSTATE <> READYSTATE_COMPLETE
Application.StatusBar = "Trying to go to website…"
DoEvents
Loop
Set html = ie.document
'Display text of HTML document returned in a cell
'Range("A1") = html.DocumentElement.innerHTML
Set ElementCol = html.getElementsByTagName("a")
For Each Link In ElementCol
erow = Worksheets("Sheet4").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Cells(erow, 1).Value = Link
Cells(erow, 1).Columns.AutoFit
Next
'close down IE, reset status bar & turn on screenupdating
'Set ie = Nothing
Application.StatusBar = ""
Application.ScreenUpdating = True
ie.Quit
ActiveSheet.Range("$A$1:$A$2752").removeDuplicates Columns:=1, Header:=xlNo
End Sub
Now can anyone will help me to create macro to find particular text from all these URLs present in column and if that text is present then in next column it should print text "text found".
Example if we search text "New" then it should print text "Text found" in next column of the URL.
Thank you.
The key would be the function Instr, if it finds the string "New", it returns the position where it begins, otherwise it returns 0.
i=1
do until trim(Cells(i,1).Value) = vbNullString
if instr(Cells(i,1).Value,"New") then
Cells(i,2).value="Text found"
end if
i=i+1
loop
Similar to above.
Dim a As Variant
a = 2
While Cells(a, 1) <> "" And Cells(a + 1, 1) <> ""
If InStr(Cells(a, 1), "new") = 0 Then
Else
Cells(a, 2) = "Text Found"
End If
a = a + 1
Wend

Reference Cell in VBA Script

I was curious if there is a way to reference a specific cell within the following VBA script. The cell contains a date in yyyymmdd format, which would go in the commented section below.
Sub OpenData()
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = False
IE.navigate "http://website.com/'desired cell value'/subdirectory/file.txt"
'Check for good connection to web page loop!
Do
If IE.readyState = 4 Then
IE.Visible = True
Exit Do
Else
DoEvents
End If
Loop
'Wait for window to open!
Application.wait (Now + TimeValue("0:00:02"))
'MsgBox "Done"
IE.Visible = True
Eric
Have you tried format?
'...
IE.navigate "http://website.com/" & Format (Cells(1,1).Value, “dd/MM/yyyy”) & "/subdirectory/file.txt" '...

Press a link on a webpage using Excel VBA

I have this code where it goes to Minecraft.net and enters the username and password, and then goes to the profile page. I need to change the password on the account, which will be in cell A1 of the worksheet. I can't seem to figure out how to click the change password link. This is my code so far:
Dim IE As Object
Sub submitFeedback3()
Application.ScreenUpdating = False
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.Navigate "https://minecraft.net/login"
Application.StatusBar = "Submitting"
' Wait while IE loading...
While IE.Busy
DoEvents
Wend
' **********************************************************************
IE.Document.getElementById("username").Value = "dddddddd"
IE.Document.getElementById("password").Value = "ddd"
IE.Document.getElementById("signin").Click
'**********************************************************************
Application.StatusBar = "Form Submitted"
Set IE = Nothing
Application.ScreenUpdating = True
End Sub
If the click doesn't work then you could try to submit the html form.
' Add reference to Microsoft Internet Controls
' Add reference to Microsoft HTML Object Library
Set IE = New InternetExplorer
IE.Visible = True
IE.Navigate "https://minecraft.net/login"
While IE.Busy
DoEvents
Wend
IE.Document.getElementById("username").Value = "dddddddd"
IE.Document.getElementById("password").Value = "ddd"
Dim htmlForm As HTMLFormElement
Set htmlForm = IE.Document.getElementById("loginForm")
htmlForm.submit

Pasting URLs That Have Been Scraped From a Webpage

So I'm looking to dump a bunch of URLs from a webpage into excel as a list. I was previously dumping the items into a listbox, but I have found that listboxes are quite difficult to work with!
Once I have collected the URLs into a column in excel, I want excel to click on each link and find the email address that is on the page. Here is the coding that I currently have...
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
url_name = Sheet1.Range("A2")
If url_name = "" Then Exit Sub
IE.Navigate (url_name)
Do
DoEvents
Loop Until IE.ReadyState = 4
Set AllHyperLinks = IE.Document.GetElementsByTagName("A")
For Each hyper_link In AllHyperLinks
Range("x":"F").Value = hyper_link
This is all I have so far! I'm not sure how to complete the loop! I want the code to paste every new URL that it finds on the page in the next empty row in column F.
You can complete the loop in this way:
Dim IE As Object, LR As Long, i As Long
LR = Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp).Row
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
For i = 2 To LR
url_name = Sheet1.Range("A" & i).Value
If url_name = "" Then Exit Sub
IE.Navigate (url_name)
Do
DoEvents
Loop Until IE.ReadyState = 4
Set AllHyperLinks = IE.Document.GetElementsByTagName("A")
For Each hyper_link In AllHyperLinks
Range("x":"F").Value = hyper_link
Next hyper_link
Next i
Please note that if you have large set of data, this is going to take a LOOOONGGGG time.