I need help with my first macro

[Davidmcg6th]

I'm trying to create a Macro VBA code excel template wherein i have list of website addresses and need to search e-mail id from the entire website by running Macro VBA code and paste it in excel. But for some reason it doesn't recognize the links. And I don't know how to code i'm using the new ai system chatgpt and it recommended me this forum. So if anyone can help that would be useful.

 

[Domenic]

I would suggest that you post your code as text within code tags so that the members here can easily copy and paste the code into a workbook to work on.

 

[Davidmcg6th]

Sub FindEmails()
Dim email As String
Dim ws As Worksheet
Dim cell As Range
Dim website As String
Dim html As String
Dim doc As Object
Dim xhr As Object

Set ws = ActiveSheet
Set doc = CreateObject("HTMLFile")

' Loop through each cell in column A of the worksheet
For Each cell In ws.Range("A1:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
' If the cell contains a hyperlink, extract the URL from the hyperlink and store it in the website variable
If cell.Hyperlinks.Count > 0 Then
website = cell.Hyperlinks(1).Address
End If

' Use the CreateObject function to create an instance of the XMLHTTP class
Set xhr = CreateObject("MSXML2.XMLHTTP")

' Use the Open method to specify the URL of the website
xhr.Open "GET", website, False

' Use the Send method to retrieve the HTML code of the website
xhr.send

' Store the website's HTML in the html variable
html = xhr.responseText

' Use the CreateObject function to create an instance of the HTMLDocument class
Set doc = CreateObject("HTMLFile")

' Load the website's HTML into the doc object
doc.body.innerHTML = html

' Use the InStr function to search the website's HTML for patterns that match email addresses
email = InStr(1, html, "[A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,}", vbTextCompare)

' If the InStr function returns 0, set the email address to an empty string
If email = 0 Then
email = ""
End If

' Use the Trim function to remove any leading or trailing white space from the email address
email = Trim(email)

' Store the email address in column C
cell.Offset(0, 2).Value = email
Next cell
End Sub






Here is the code if anybody can help