Private Sub Komut2_Click()
    Dim strFilter As String
    Dim strInputFileName As String
    Dim hp As Hyperlink
strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)", "*.xls") & ahtAddFilterItem(strFilter, "Excel Files (*.Doc)", "*.Doc")
strInputFileName = ahtCommonFileOpenSave(Filter:=strFilter, OpenFile:=True, _
    DialogTitle:="Lütfen xls ve Doc uzantılı dosyaları seçiniz.", _
    Flags:=ahtOFN_HIDEREADONLY)
 
    If strInputFileName = "*.xls" Then
        Link.Caption = ""
    Else
        Me.Link.ForeColor = vbBlue
        Me.Link.FontUnderline = True
        Link.Caption = strInputFileName
        Me.Link.HyperlinkAddress = strInputFileName
 
    End If  
 
End Sub

Private Sub Komut2_Click()
    Dim strFilter As String
    Dim strInputFileName As String
 
strFilter = _
ahtAddFilterItem(strFilter, "Excel Files (*.xls)", "*.xls")
 
strFilter = _
ahtAddFilterItem(strFilter, "Access Files (*.mdb)", "*.MDB")
 
strInputFileName = ahtCommonFileOpenSave(Filter:=strFilter, OpenFile:=True, _
    DialogTitle:="Lütfen xls ve Doc uzantılı dosyaları seçiniz.", _
    Flags:=ahtOFN_HIDEREADONLY)
 
    Link.SetFocus
 
    If strInputFileName = "*.xls" Then
        Link.Text = ""
        Exit Sub
    Else
        Set Me.Recordset = XL(strInputFileName)
    End If
End Sub
 
Function XL(strWB As String) As ADODB.Recordset
Dim XLapp As Object, wb As Object, s As Object
Dim fRS As New ADODB.Recordset
Dim h As Hyperlink
 
 On Error Resume Next
 
    Set XLapp = CreateObject("Excel.Application")
    fRS.Fields.Append "fLink", adVarChar, 255
    fRS.Open
 
    Set wb = XLapp.workbooks.Open(strWB)
 
    For Each s In wb.Sheets
 
        For Each h In s.Hyperlinks
            fRS.AddNew
            fRS("fLink").Value = s.Name & ">>>" & h.Address
        Next
    Next
 
    Set XL = fRS
    wb.Close False
    Set wb = Nothing
End Function