PDA

View Full Version : accessing data from intranet and copy pasting it into the appropriate cell



ArmySanta
02-28-2023, 12:54 PM
What am I doing wrong?
At the line xmlHTTP1.Open "GET", url1, False I am getting a Run-time error '424': Object required



Sub FindAndEnterData()


Dim xmlHTTP2 As Object
Set xmlHTTP2 = CreateObject("MSXML2.XMLHTTP.6.0")


Dim htmlDoc1 As Object
Set htmlDoc1 = CreateObject("HTMLFile")


Dim htmlDoc2 As Object
Set htmlDoc2 = CreateObject("HTMLFile")


Dim allTables1 As Object
Set allTables1 = htmlDoc1.getElementsByTagName("table")


Dim allTables2 As Object
Set allTables2 = htmlDoc2.getElementsByTagName("table")


Dim table1 As Object
Set table1 = Nothing


Dim table2 As Object
Set table2 = Nothing


Dim currentRow1 As Object
Set currentRow1 = Nothing


Dim currentRow2 As Object
Set currentRow2 = Nothing


Dim currentRow1Data As String
Dim currentRow2Data As String
Dim searchData As String
Dim matchFound As Boolean
Dim i As Integer
Dim j As Integer


Dim url1 As String
url1 = "intranet website 1" 'you can't access the intranet website anyways


Dim url2 As String
url2 = "intranet website 2" 'you can't access the intranet website anyways




j = 2 ' starting row of data in Excel sheet


Do While Not IsEmpty(Sheets("Course_by_mods").Range("I" & j))
searchData = Sheets("Course_by_mods").Cells(j, 6).Value & Sheets("Course_by_mods").Cells(j, 10).Value & Sheets("Course_by_mods").Cells(j, 11).Value


' Make a GET request to URL1 and check if the data matches
xmlHTTP1.Open "GET", url1, False
xmlHTTP1.send


Set htmlDoc1 = CreateObject("HTMLFile")
htmlDoc1.body.innerHTML = xmlHTTP1.responseText
Set allTables1 = htmlDoc1.getElementsByTagName("table")


For Each table1 In allTables1
If table1.Rows.Length > 0 Then
For i = 1 To table1.Rows.Length - 1
Set currentRow1 = table1.Rows(i)
currentRow1Data = currentRow1.Cells(5).innerText & currentRow1.Cells(9).innerText
If currentRow1Data = searchData Then
matchFound = True
Sheets("Course_by_mods").Cells(j, 10).Value = currentRow1.Cells(5).innerText ' enter data in column J
Sheets("Course_by_mods").Cells(j, 11).Value = currentRow1.Cells(9).innerText ' enter data in column K
Exit For
End If
Next i
End If
Next table1


' Make a GET request to URL2 and check if the data matches
xmlHTTP2.Open "GET", url2, False
xmlHTTP2.send


Set htmlDoc2 = CreateObject("HTMLFile")
htmlDoc2.body.innerHTML = xmlHTTP2.responseText
Set allTables2 = htmlDoc2.getElementsByTagName("table")


For Each table2 In allTables2
If table2.Rows.Length > 0 Then
For i = 1 To table2.Rows.Length - 1
Set currentRow2 = table2.Rows(i)
currentRow2Data = currentRow2.Cells(5).innerText & currentRow2.Cells(9).innerText
If currentRow2Data = searchData Then
matchFound = True
Sheets("Course_by_mods").Cells(j, 10).Value = currentRow1.Cells(5).innerText ' enter data in column J
Sheets("Course_by_mods").Cells(j, 11).Value = currentRow1.Cells(9).innerText ' enter data in column K
Exit For
End If
Next i
End If
Next table2

Loop
End Sub

arnelgp
02-28-2023, 05:01 PM
you can also use:

Set xmlHTTP2 = CreateObject("MSXML2.XMLHTTP")

and it will use whatever the latest object you have installed on your system.

ArmySanta
03-01-2023, 08:59 AM
Still not working