Creating .m3u from Hyperlinks

[eltorito]

Hey Everybody!

Noob here. Very new to VB and using it with Excel. Like 2 days. I've been able to pick up tonnes of info from this site and Google, but can't make it any further on my own.

I've created a worksheet containing all the MMA fights I have ripped to my PC (~500). I have columns for Winner, Loser and Hyperlink. I have setup a filter that will show only the fights with a certain fight, win or lose. I'd like to take that filtered information and copy it into .m3u playlist file to load into a media player.

What I've been able to figure out so far is:

Sub WriteToATextFile()
Set WshShell = CreateObject("WScript.Shell")
    ChDir (WshShell.SpecialFolders("desktop"))
MyFile = "" & "playlist.m3u"
fnum = FreeFile()
Open MyFile For Output As fnum
Print #fnum, "#EXTM3U"
Print #fnum,
Print #fnum, "#EXTINF:,(FRIENDLY_NAME of 1st Result)"
Print #fnum, "(LINK_LOCATION)"
Print #fnum,
Print #fnum, "#EXTINF:,(FRIENDLY_NAME of 2nd Result)"
Print #fnum, "(LINK_LOCATION)"
Print #fnum,
'at this point it would loop until it hit the end of the filtered results
Close #fnum
End Sub

How do I setup the loop to continue writing the information to the playlist until it hit the end of the filtered results? Also, how do I extract the friendly name and link location from the hyperlinks?



Don't know if it makes a difference or not, but I did not used CRTL+K to create the hyperlinks, not the =hyperlink function.

Thanks in advance for your help!

 

[eltorito]

I've been busy Googling, and compiled the following mess of code:

Option Explicit
 
Private Function GetHyperAddy(cell As Range) As String
     'Function purpose:  To return a hyperlink address if one exists
     'Assigns a value of "None" to the string if no hyperlink is present
     
    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
Dim title As Range, cell As Range, wshshell As Object, myfile As String, fnum As String

Application.ScreenUpdating = False
'clear data columns. ensures beginning of working data is in b2 & c2, otherwise it just appends
'to the bottom of previously generated data
Worksheets("sheet2").Columns("a:c").ClearContents
'copy filtered hyperlinks to formula sheet to work with and delete header rows
Worksheets("sheet1").Columns("J:J").Copy Destination:=Worksheets("Sheet2").Range("A1")
Worksheets("sheet2").Rows("1:2").Delete

Set clSource = Worksheets("sheet2").Range("A:A")
  For Each cl In clSource
         'Get the hyperlink address
        HyperAddy = GetHyperAddy(cl)
        
        If Not HyperAddy = "None" Then
            With Worksheets("sheet2").Range("B65536").End(xlUp).Offset(1, 0)
                 'List link's display text in column b.
                .Offset(0, 0).Value = cl.Text
                 'list link in column c
                .Offset(0, 1).Value = HyperAddy
                
            End With
        End If
    Next cl
'broken down hyperlinks for a1 appear in b2 &c2; a2 in b3 & c3, etc. the places it back into b1
Worksheets("sheet2").Rows("1:1").Delete

'the generate playlist saves to the user's desktop; can't figure out how to simply clear the
'file prior to writing the new playlist.
Set wshshell = CreateObject("WScript.Shell")
    ChDir (wshshell.SpecialFolders("desktop"))
Dim KillFile  As String
KillFile = "playlist.m3u"
If Len(Dir$(KillFile)) > 0 Then
    SetAttr KillFile, vbNormal
     Kill KillFile
End If

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

Close #fnum


End Sub

The idea is to write the file like:

#EXTINF:,b1
c1

#EXTINF:,b2
c2

But it is instead writing:

#EXTINF:,a1
b1

#EXTINF:,b1
c1

#EXTINF:,a2
b2

#EXTINF:,b2
c2


Does someone see where I've gone wrong??? Help!!!

 

[eltorito]

Didn't realize how long my code was until after I posted it. I'm pretty sure the issue is in this section:

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