Tuesday, September 27, 2022

To Create Hyperlink with Excel VBA

 In Microsoft Excel to insert Hyperlink just click at Insert Tab and click at Link world icon with chain. Key in Text to display, add ScreenTip if you wish and select link or location. To convert into HTML we have save this selection link as webpage and publish. We also can use VBA code to convert this link into HTML code. For example we have table as below.


Run below code to get HTML code inside notepad.

VBA Code:

Option Explicit
Sub ToCreate_HyperLinkListing_Reference()
        
    Dim OpenShell As Variant
    Dim FSO, fs As Object
    
    Dim MstWS As Worksheet
    Dim StrPath As String
    Dim Rw As Long
    
    Dim BrktCls As String, Qto As String
    Dim HpLinkOpn As String, HpLinkCls As String
    Dim TtlTag As String, StrTgt As String
    Dim BrTag As String
    Dim pTgOpn As String, pTgCls As String
    
    Dim StrTitle As String, StrAchText As String, StrLink As String
    
    'Assign Variables
    Set MstWS = ActiveSheet
    BrktCls = ">": Qto = """"
    HpLinkOpn = "<a href=": HpLinkCls = "</a>"
    TtlTag = " title="
    StrTgt = "target=" & Qto & "_blank" & Qto
    BrTag = "<br />"
    pTgOpn = "<p>": pTgCls = "</p>"
    
    'To Create new Text File
    StrPath = VBA.Environ("UserProfile") & "\Desktop\MacroReadMe.txt"
    
    'Create Object to open Notepad
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    'To Check files existance and delete old file
    On Error Resume Next
    If Dir(StrPath) <> "" Then Kill StrPath

    'To write into NotePad
    If Dir(StrPath) = "" Then
        Set fs = FSO.CreateTextFile(StrPath, 2)
        With fs
            Rw = 3
            Do While MstWS.Range("B" & Rw) <> ""
            
                StrTitle = MstWS.Range("C" & Rw)
                StrAchText = MstWS.Range("B" & Rw)
                StrLink = MstWS.Range("D" & Rw)
                
                .WriteLine HpLinkOpn & Qto & StrLink & Qto & TtlTag & _
                Qto & StrTitle & Qto & " " & StrTgt & BrktCls & _
                StrAchText & HpLinkCls & BrTag
                
                StrTitle = "": StrAchText = "": StrLink = ""
                Rw = Rw + 1
            Loop
        End With
    End If

    'Just To Open NotePad Created
    If Err = 0 Then
        OpenShell = Shell("C:\Windows\System32\notepad.exe " & _
        StrPath, vbNormalFocus)
    End If
    On Error GoTo 0
    
    'Reset Variables
    StrPath = ""
    BrktCls = "": Qto = ""
    HpLinkOpn = "": HpLinkCls = ""
    TtlTag = "": BrTag = ""
End Sub

The result in HTML as below:

Microsoft Excel VBA
Computer Resources
Digital Camera Resources
Computer Games Collection

Practice makes perfect. Thank You.

No comments:

Post a Comment