Posted: Sun Mar 07, 2004 11:49 pm
You are welcome!
I assume it works, I guess?
I assume it works, I guess?
The Music Manager for Serious Collectors
http://forum.mediamonkey.com/
Code: Select all
' Iterate through the list and export all songs
Progress.MaxValue = list.count
Dim i, itm
Dim prevArtist, prevAlbum, j
for i=0 to list.count-1
Set itm = list.Item(i)
if prevArtist = itm.ArtistName then
WS.Cells(i+2,1).Value = ""
else
WS.Cells(i+2-j,1).Value = itm.ArtistName
end if
if prevAlbum = itm.AlbumName then
WS.Cells(i+2,2).Value = ""
j = j+1
else
WS.Cells(i+2-j,2).Value = itm.AlbumName
end if
prevArtist = itm.ArtistName
prevAlbum = itm.AlbumName
Progress.Value = i+1
if Progress.Terminate then
Exit For
end if
next
Code: Select all
Option Explicit ' report undefined variables, ...
' function for quoting strings
Function QStr( astr)
QStr = chr(34) & astr & chr(34)
End Function
Dim list ' list of songs to be exported
Dim res ' results of dialogs calls
Dim fullfile ' fully specified output file name
Dim fso ' FileSystemObject
' SDB variable is connected to MediaMonkey application object
Sub InitExport( ext, filter, iniDirValue)
fullfile = ""
' Get a list of songs to be exported
Set list = SDB.SelectedSongList
If list.count=0 Then
Set list = SDB.AllVisibleSongList
End If
If list.count=0 Then
res = SDB.MessageBox( "Select tracks to be exported, please.", mtError, Array(mbOk))
Exit Sub
End If
' Open inifile and get last used directory
Dim iniF
Set iniF = SDB.IniFile
' Create common dialog and ask where to save the file
Dim dlg
Set dlg = SDB.CommonDialog
dlg.DefaultExt=ext
dlg.Filter=filter
dlg.Flags=cdlOFNOverwritePrompt + cdlOFNHideReadOnly
dlg.InitDir = iniF.StringValue( "Scripts", iniDirValue)
dlg.ShowSave
if Not dlg.Ok Then
Exit Sub ' if cancel was pressed, exit
End If
' Get the selected filename
fullfile = dlg.FileName
' Connect to the FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
' Write selected directory to the ini file
iniF.StringValue( "Scripts", iniDirValue) = fullfile
End Sub
Sub FinishExport( ok)
On Error Resume Next
' remove the output file if terminated
if not Ok then
fso.DeleteFile( fullfile)
end if
' Notify user that it was successful
if ok then
res = SDB.MessageBox( "Export was completed successfully.", mtInformation, Array(mbOk))
else
res = SDB.MessageBox( "Export was terminated.", mtInformation, Array(mbOk))
end if
End Sub
Sub ExportXLS
' initialize export
Call InitExport( ".xls", "Excel sheet (*.xls)|*.xls|All files (*.*)|*.*", _
"LastExportExcelDir")
if fullfile="" then
Exit Sub
end if
if fso.FileExists( fullfile) then
fso.DeleteFile( fullfile)
end if
On Error Resume Next
' Connect to Excel
Dim Excel, WB, WS
Set Excel = CreateObject("Excel.application")
If Err.Number<>0 then
MsgBox "Microsoft Excel could not be found, please install it and try again."
Err.Clear
Exit Sub
End If
On Error GoTo 0
' Create a new workbook and get its worksheet
Set WB = Excel.WorkBooks.Add
Set WS = WB.Sheets(1)
' Use progress to notify user about the current action
Dim Progress
Set Progress = SDB.Progress
Progress.Text = "Exporting to an Excel file..."
' Create a header
WS.Cells(1,1).Value = "Artist"
WS.Cells(1,2).Value = "Album"
WS.Rows("1:1").Font.Bold = True
' Iterate through the list and export all songs
Progress.MaxValue = list.count
Dim i, itm
Dim prevArtist, prevAlbum, j
for i=0 to list.count-1
Set itm = list.Item(i)
if prevArtist = itm.ArtistName then
WS.Cells(i+2,1).Value = ""
else
WS.Cells(i+2-j,1).Value = itm.ArtistName
end if
if prevAlbum = itm.AlbumName then
WS.Cells(i+2,2).Value = ""
j = j+1
else
WS.Cells(i+2-j,2).Value = itm.AlbumName
end if
prevArtist = itm.ArtistName
prevAlbum = itm.AlbumName
Progress.Value = i+1
if Progress.Terminate then
Exit For
end if
next
' Was it successfull?
Dim ok
if Progress.Terminate then
ok = False
else
ok = True
WB.SaveAs fullfile
end if
WB.Close false
' hide progress
Set Progress = Nothing
FinishExport( ok)
End Sub
j calculations by not placing "" in cells of the worksheet.
If (itm.ArtistName <> prevArtist) && (itm.Album <> prevAlbum) then
write artist in cell
write album in cell
Else If (itm.ArtistName == prevArtist) && (itm.Album <> prevAlbum) then
write empty artist cell
write album cell
Else
Do nothing (as artist and album are already written by previous track
End if
maybe deleting the -j gets you somewhere. Anyway the code works so that's perfect. No real need to change it.WS.Cells(i+2-j,1).Value = itm.ArtistName
Code: Select all
' Iterate through the list and export all songs
Progress.MaxValue = list.count
Dim i, itm
Dim prevArtist, prevAlbum, j
for i=0 to list.count-1
Set itm = list.Item(i)
if (prevArtist <> itm.ArtistName) && (prevAlbum <> itm.AlbumName) then
WS.Cells(i+2,1).Value = itm.ArtistName
WS.Cells(i+2,2).Value = itm.AlbumName
else if (prevArtist == itm.ArtistName) && (prevAlbum <> itm.AlbumName) then
WS.Cells(i+2,1).Value = ""
WS.Cells(i+2,2).Value = itm.AlbumName
else
end if
end if
prevArtist = itm.ArtistName
prevAlbum = itm.AlbumName
Progress.Value = i+1
if Progress.Terminate then
Exit For
end if
next
Code: Select all
else
end if
end if
Code: Select all
else
end if
Code: Select all
' Iterate through the list and export all songs
Progress.MaxValue = list.count
Dim i, itm
Dim prevArtist, prevAlbum, j
for i=0 to list.count-1
Set itm = list.Item(i)
if prevArtist <> itm.ArtistName then
WS.Cells(i+2-j,1).Value = itm.ArtistName
end if
if prevAlbum <> itm.AlbumName then
WS.Cells(i+2-j,2).Value = itm.AlbumName
else
j=j+1
end if
prevArtist = itm.ArtistName
prevAlbum = itm.AlbumName
Progress.Value = i+1
if Progress.Terminate then
Exit For
end if
next