Sharid
Well-known Member
- Joined
- Apr 22, 2007
- Messages
- 1,064
- Office Version
- 2016
- Platform
- Windows
I have a code which pulls off the social media url link to a site if it has a social media on the site. I need a bit of help to update this code and I can not work it out.
Currently
It starts from rows 2 in the ACTIVE SHEET and places the data into the the ACTIVE SHEET.
What I need
I need it to get the url list from Sheet3 and place the data into Sheet3 columns as stated in the code. It should not matter what sheet I am on, the urls are lisited in sheet3 and the data should also go into that sheet.
Currently
It starts from rows 2 in the ACTIVE SHEET and places the data into the the ACTIVE SHEET.
What I need
I need it to get the url list from Sheet3 and place the data into Sheet3 columns as stated in the code. It should not matter what sheet I am on, the urls are lisited in sheet3 and the data should also go into that sheet.
VBA Code:
Command Button1_Click ()
Dim counter As Long
Dim website As Range
Dim row As Long
Dim continue As Boolean
Dim respHead As String
''''The row where website addresses start
row = 2
continue = True
Set http = CreateObject("MSXML2.ServerXMLHTTP.6.0")
Do While continue
'''Could set this to first cell with URL then OFFSET columns to get next web site
' Set website = Range("A" & row)
Set website = Range("A" & row)
If Len(website.Value) < 1 Then
continue = False
Exit Sub
End If
If website Is Nothing Then
continue = False
End If
'''Debug.Print website
With http
On Error Resume Next
.Open "GET", website.Value, False
.send
'''If the website sent a valid response to our request, URLS ARE IN COLUMN A
If Err.Number = 0 Then
If .Status = 200 Then
HTML.body.innerHTML = http.responseText
Set links = HTML.getElementsByTagName("a")
'''COLUMN C = FACEBOOK
For Each link In links
If InStr(UCase(link.outerHTML), "FACEBOOK") Then
Website.Offset(0, 2).Value = link.href
End If
'''COLUMN D = TWITTER
If InStr(UCase(link.outerHTML), "INSTAGRAM") Then
Sheet3.Cells.website.Offset(0, 3).Value = link.href
End If
Next
End If
Set website = Nothing
Else
'''Debug.Print "Error loading page IN COLUMN H"
website.Offset(0, 8).Value = "Error with website address"
End If
On Error GoTo 0
End With
row = row + 1
Loop
End Sub