Exporting Absolute Hyperlink Locations to Text File

[eltorito]

Hey Everyone,

I previously posted a request to help me automate play list creation from a filtered list here. In my first post, I asked for way too much help and my second post, I posted way too much code. Never got a reply, so I'm going to keep it simple this time.

I need to know how to extract a relative hyperlinks absolute link. What I have so far is:

Private Function GetHyperAddy(cell As Range) As String

    On Error Resume Next
    GetHyperAddy = cell.Hyperlinks.Item(1).Address
    If Err.Number <> 0 Then GetHyperAddy = "None"
    On Error GoTo 0
     
End Function

Sub playlist()

Dim HyperAddy As String, cl As Range, clSource As Range

Set clSource = Worksheets("sheet2").Range("A:A")
  For Each cl In clSource
        HyperAddy = GetHyperAddy(cl)
        
        If Not HyperAddy = "None" Then
            With Worksheets("sheet2").Range("B65536").End(xlUp).Offset(1, 0)
                .Offset(0, 0).Value = cl.Text
                .Offset(0, 1).Value = HyperAddy
                
            End With
        End If
    Next cl

The link returned is the relative link I used to create the hyperlink, I need to convert it to an absolute. Any ideas?

 

[eltorito]

Finally got it.

The spreadsheet exists in a folder with many sub folders containing the files I wanted to create filtered play lists for. All I did was add the spreadsheets path and a "\" before the relative link location while writing the file. Here is the file writing loop:

addy = ThisWorkbook.Path
myfile = "" & "playlist.m3u"
fnum = FreeFile()
Open myfile For Output As fnum
Print #fnum, "#EXTM3U"
Print #fnum,
ActiveWorkbook.Worksheets("Sheet2").Select
Set title = Range(Range("a1:a1"), Cells(Rows.Count, 1).End(xlUp))
For Each cell In title
 Print #fnum, "#EXTINF:,"; cell.Text
Print #fnum, addy; "\"; cell.Offset(0, 1).Text
Print #fnum,
Next

Close #fnum

Cheap and effective. I am going to post my code in my previous thread in case anyone is interested in it or interested in helping me clean it up.