Köprümüzün şöyle olduğunu düşünürsek

[email protected]#mailto:[email protected]#

köprü metnini almak için

Public Function GetHyperlinkRawData(ByVal hyperlinkData As Variant) As Variant

    GetHyperlinkRawData = hyperlinkData

End Function

tek tıklamaya yanıt vermesi için

Private Sub txtHyperlinkFullAddress_Click()

On Error GoTo txtHyperlinkFullAddress_Click_Err



    If Not IsNull(Me.txtHyperlinkFullAddress.Value) Then

        Application.FollowHyperlink Me.txtHyperlinkFullAddress.Value

    End If



Exit Sub



txtHyperlinkFullAddress_Click_Err:

    Call MsgBox("Error " & Err.Number & " - " & Err.Description & " (in " & Me.Name & ".txtHyperlinkFullAddress_Click)")

End Sub

---

DisplayText'i köprü sütunundan ayıklamak için

Public Function GetHyperlinkDisplayText(ByVal hyperlinkData As Variant) As Variant



    Const SEPARATOR As String = "#"



    Dim retVal As Variant

    Dim tmpArr As Variant

    

    If IsNull(hyperlinkData) Then

        retVal = hyperlinkData

    Else

        

        tmpArr = Split(hyperlinkData, SEPARATOR)

    

        If Len(tmpArr(0)) > 0 Then

            retVal = tmpArr(0)

        Else

            retVal = tmpArr(1)

            If Len(tmpArr(2)) > 0 Then

                retVal = retVal & "#" & tmpArr(2)

            End If

        End If

    

    End If



    GetHyperlinkDisplayText = retVal



End Function

---

DisplayText i almak için

Public Function GetHyperlinkFullAddress(ByVal hyperlinkData As Variant, Optional ByVal removeMailto As Boolean) As Variant



    Const SEPARATOR As String = "#"



    Dim retVal As Variant

    Dim tmpArr As Variant

    

    If IsNull(hyperlinkData) Then

        retVal = hyperlinkData

    Else

        

        If InStr(hyperlinkData, SEPARATOR) > 0 Then

            ' I append 4 separators at the end, so I don't have to worry about the

            ' lenght of the array returned by Split()

            hyperlinkData = hyperlinkData & String(4, SEPARATOR)

            tmpArr = Split(hyperlinkData, SEPARATOR)

            

            If Len(tmpArr(1)) > 0 Then

                retVal = tmpArr(1)

                If Len(tmpArr(2)) > 0 Then

                    retVal = retVal & "#" & tmpArr(2)

                End If

            End If

        Else

            retVal = hyperlinkData

        End If

    

        If Left(retVal, 7) = "mailto:" Then

            retVal = Mid(retVal, 8)

        End If

    

    End If



    GetHyperlinkFullAddress = retVal



End Function