by Plethora » Mon Mar 08, 2004 1:13 am
Hey it's working as far as I can tell!!!
Here is what we were working on
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
There might be a way to get rid of the j calculations by not placing "" in cells of the worksheet. I'll have to work with that later, but as of right now it is working on my entire library. Some editing is needed in Excel to make it look pretty but I like Excel for transfering over to my PDA. This way I'll never buy duplicate CD's again
! With 11,822 MP3's the chances are great!
And if your looking for the whole code!!
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
THNX LOWLANDER!!!!
:D Hey it's working as far as I can tell!!!
Here is what we were working on[code]
' 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]
There might be a way to get rid of the j calculations by not placing "" in cells of the worksheet. I'll have to work with that later, but as of right now it is working on my entire library. Some editing is needed in Excel to make it look pretty but I like Excel for transfering over to my PDA. This way I'll never buy duplicate CD's again :lol: ! With 11,822 MP3's the chances are great!
And if your looking for the whole code!!
[code]
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
[/code]
THNX LOWLANDER!!!!