Macro that opens hyperlink

**hogsrul** · 10-14-2010, 11:06 PM

I am really green when it comes to VBA's and macros, so please bear with me.

What I am trying to do is take a column of URL's, create a macro that will open each URL, go to the area of the website that has the specific data that I need and return that data to the appropriate cell next to the collected URL. The URL is in this form =Hyperlink(L45&...)

Is it possible to do this?

Thanks for the help, I have been struggling with this all day!

**pr4t3ek** · 10-14-2010, 11:15 PM

don't think this can be done with Excel VBA. you may want to use other macro recording tools like http://www.jitbit.com/macro-recorder/

i would be very surprised if anyone has a solution to this via excel vba

**hogsrul** · 10-15-2010, 08:50 AM

How about just a macro to activate the =hyperlink?

**pr4t3ek** · 10-17-2010, 06:44 PM

this will open the web-page. Assuming the hyperlink is in cell A1

Range("A1").Select
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True

**Leith Ross** · 10-17-2010, 09:38 PM

Hello hogsrul
,

Here is the code to do this using VBA. Copy this into a Standard VBA module.

'Written: October 17, 2010
'Author:  Leith Ross
'Summary: Opens an Excel worksheet hyperlink that uses the hyperlink formula.

 Private Declare Function ShellExecute _
  Lib "Shell32.dll" _
    Alias "ShellExecuteA" _
     (ByVal hWnd As Long, _
      ByVal lpOperation As String, _
      ByVal lpFile As String, _
      ByVal lpParameters As String, _
      ByVal lpDirectory As String, _
      ByVal nShowCmd As Long) _
  As Long

Sub OpenHyperlink(Rng As Range)

  Dim Formula As String
  Dim Msg As String
  Dim RegExp As Object
  Dim RetVal As Long
  Dim URL As Variant
  
    Set RegExp = CreateObject("VBScript.RegExp")
    
    RegExp.Pattern = "(.+\()(.+)\,(.*)\)"
    
      Formula = Rng.Cells(1, 1).Formula
      If Formula = "" Then Exit Sub
      
      If RegExp.Test(Formula) = True Then
         URL = RegExp.Replace(Formula, "$2")
         URL = [URL]
         RetVal = ShellExecute(0&, "open", URL, "", "", 1&)
      Else
         Exit Sub
      End If
      
      If RetVal <= 32 Then
         Select Case RetVal
           Case 2     'SE_ERR_FNF
             Msg = "File not found"
           Case 3      'SE_ERR_PNF
             Msg = "Path not found"
           Case 5      'SE_ERR_ACCESSDENIED
             Msg = "Access denied"
           Case 8      'SE_ERR_OOM
             Msg = "Out of memory"
           Case 32     'SE_ERR_DLLNOTFOUND
             Msg = "DLL not found"
           Case 26     'SE_ERR_SHARE
             Msg = "A sharing violation occurred"
           Case 27     'SE_ERR_ASSOCINCOMPLETE
             Msg = "Incomplete or invalid file association"
           Case 28     'SE_ERR_DDETIMEOUT
             Msg = "DDE Time out"
           Case 29     'SE_ERR_DDEFAIL
             Msg = "DDE transaction failed"
           Case 30     'SE_ERR_DDEBUSY
             Msg = "DDE busy"
           Case 31     'SE_ERR_NOASSOC
             Msg = "Default Email not configured"
           Case 11     'ERROR_BAD_FORMAT
             Msg = "Invalid EXE file or error in EXE image"
           Case Else
             Msg = "Unknown error"
         End Select
       
        Msg = "Unable to Open Hyperlink Address " & vbCrLf & "'" & URL & "'" & vbCrLf _
            & vbCrLf & "Error Number " & CStr(RetVal) & vbCrLf & Msg
        MsgBox Msg, vbExclamation + vbOKOnly, "HyperLink Error"
      End If

End Sub

Example of calling the Macro in VBA
This example assumes the cell "A2" contains a hyperlink formula: "=HYPERLINK(link_location,friendly_name)". If the cell does not contain a hyperlink formula then nothing happens. If an error occurs while open the hyperlink then an error message is displayed along with the error number and a description.