I really did it this time
Hey LowlanderCode: Select all
' Iterate through the list and export all songs
Progress.MaxValue = list.count
Dim i, itm
for i=0 to list.count-1
Set itm = list.Item(i)
if itm.art = itm.ArtistName then
WS.Cells(i+2,1).Value = "& n b s p ;"
else
WS.Cells(i+2,1).Value = itm.ArtistName
end if
if itm.alb = itm.AlbmName then
WS.Cells(i+2,2).Value = "& n b s p ;"
else
WS.Cells(i+2,2).Value = itm.AlbumName
end if
Set itm.art = itm.ArtistName
Set itm.alb = itm.AlbumName
Progress.Value = i+1
if Progress.Terminate then
Exit For
end if
next
This part is the key in the code as it checks the new track to be written to the output file is the same as before.If itm.AlbumName <> currentalbum Then
fout.WriteLine "<TR><TD COLSPAN=6 ID=album><BR><BR>"&itm.AlbumName&"</TD></TR>"
currentalbum=itm.AlbumName
the list should just contain the artist subdivided into albums.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
for i=0 to list.count-1
Set itm = list.Item(i)
if itm.art = itm.ArtistName then
WS.Cells(i+2,1).Value = "&"
else
WS.Cells(i+2,1).Value = itm.ArtistName
end if
if itm.alb = itm.AlbmName then
WS.Cells(i+2,2).Value = "&"
else
WS.Cells(i+2,2).Value = itm.AlbumName
end if
Set itm.art = itm.ArtistName
Set itm.alb = 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
Code: Select all
' Iterate through the list and export all songs
Progress.MaxValue = list.count
Dim i, itm
for i=0 to list.count-1
Set itm = list.Item(i)
if itm.art = itm.ArtistName then
WS.Cells(i+2,1).Value = ""
else
WS.Cells(i+2,1).Value = itm.ArtistName
end if
if itm.alb = itm.AlbmName then
WS.Cells(i+2,2).Value = ""
else
WS.Cells(i+2,2).Value = itm.AlbumName
end if
Set itm.art = itm.ArtistName
Set itm.alb = itm.AlbumName
Progress.Value = i+1
if Progress.Terminate then
Exit For
end if
next
Code: Select all
[Export for Excel]
Filename=Outputlist.vbs
ProcName=ExportXLS
Order=1
DisplayName=Output The List
Language=VBScript
ScriptType=1
I replaced the itm.art with currentArtist as described before it probably doesn't work with a . in the name. It still would need to be replaced for the remaining code.Iterate through the list and export all songs
Progress.MaxValue = list.count
Dim i, itm
Dim currentArtist, currentAlbum
for i=0 to list.count-1
Set itm = list.Item(i)
if currentArtist = itm.ArtistName then
WS.Cells(i+2,1).Value = ""
else
.......
Code: Select all
' Iterate through the list and export all songs
Progress.MaxValue = list.count
Dim i, itm
Dim prevArtist, prevAlbum
for i=0 to list.count-1
Set itm = list.Item(i)
WS.Cells(i+2,1).Value = itm.ArtistName
WS.Cells(i+2,2).Value = itm.AlbumName
**
Progress.Value = i+1
if Progress.Terminate then
Exit For
end if
next
You can't use set here. It's just prevartist = itm.ArtistName.Set prevartist = itm.ArtistName
and the one for album as well.if currentArtist = itm.ArtistName then
WS.Cells(i+2,1).Value = ""
else
WS.Cells(i+2,1).Value = itm.ArtistName
end if
