Should be obvious what it does:
Sub Parse_Emails()
'
' Parse_Emails Macro
' Written by Excel_Geek
'
'I JUST ADDED THIS TO ACT AS A SAFEGUARD AGAINST ACCIDENTALLY CLICKING THE "GET EMAILS" BUTTON
varAnswer = MsgBox("Are you sure you're ready? You've got the URL range and the starting email cell set right?", vbYesNo, "HOLD ON THERE...")
If varAnswer = 7 Then
Exit Sub
End If
'SELECT THE CELL INTO WHICH THE FIRST EMAIL ADDRESS FOUND CAN GO
Range("C2").Select
'DEFINE "cel" AS EACH CELL WITHIN THE RANGE DEFINED BELOW
Dim cel As Range
'SET THE RANGE OF THE URLS FROM WHICH TO PARSE EMAILS
For Each cel In Range("A2:A49").Cells
'SET THE VALUE OF EACH CELL AS THE "WEB_PAGE" FROM WHICH YOU'LL PARSE EMAILS
WEB_PAGE = cel.Value
pageParseRequest = WEB_PAGE
If pageParseRequest <> "" Then
Set regEx = CreateObject("VBScript.regexp")
regEx.Global = True
regEx.IgnoreCase = True
regEx.Pattern = "([a-z0-9\._-]+@+[a-z0-9\._-]+\.+[a-z]{2,4})"
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
objHTTP.Open "GET", pageParseRequest, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.send ("")
' If objHTTP.Status <> 200 Then ' Could not retrieve SOAP message
' Response.Write objHTTP.Status
' Set objHTTP = nothing
' Response.End()
' End If
pageToParse = objHTTP.responseText
Set objHTTP = Nothing
Set expressionmatch = regEx.Execute(pageToParse)
'varAnswer = MsgBox(expressionmatch.Count, vbOKOnly, "NOTICE!")
If expressionmatch.Count > 0 Then
For Each expressionmatched In expressionmatch
ActiveCell.FormulaR1C1 = expressionmatched.Value
'varAnswer = MsgBox(expressionmatched.Value, vbOKOnly, "NOTICE!")
ActiveCell.Offset(1, 0).Select
'Response.Write "<B>" & expressionmatched.Value & "</B> was matched at position <B>" & expressionmatched.FirstIndex & "</B><BR>"
'Response.Write Right(expressionmatched.Value, Len(expressionmatched.Value) - 7) & "<br />"
Next
'Else
'Response.Write "<B>" & regEx.Pattern & "</B> was not found in the string: <B>" & StringToSearch & "</B>."
End If
End If
'Response.Write( "<xmp>" & pageToParse & "</xmp>" )
With cel.Interior
.ColorIndex = 43
.Pattern = xlSolid
End With
Next
End Sub
Sorry about the commented out remnants of web programming in there.
2 comments:
Please contact me regarding your excel tools. We comply with the can-spam act, however, we would like to have a spreadsheet programmed to automatically generate email addresses. For instance, if we have the domain, email configuration (john.smith@ or jsmith@), by using macros, we should be able to mass import names to develop emails based on the above criteria. Do you have any experience with this? Would you be able to build?
Thank you
Sure. That would be a snap. Just contact me at ehunzeker@gmail.com with details.
Post a Comment