Saturday, July 05, 2008

Determine the length of all audio CD tracks, Very fast with Excel

This macro will list the duration of all the tracks on an audio CD inserted in your CD ROM.

Open Excel
On the Tools menu, point to Macro, and then click Visual Basic Editor (or Alt F11)
Copy text between the lines below:
Option Explicit

Private Declare Function mciSendString Lib "winmm.dll" _
Alias "mciSendStringA" (ByVal lpstrCommand As String, _
ByVal lpstrReturnString As String, _
ByVal uReturnLength As Long, _
ByVal hwndCallback As Long) As Long

Sub AudioCD_InsertTime()

Static S As String * 30
Dim Cmd As String
Dim Counter As Integer, Answer As Integer
Dim Min As Integer, Sec As Integer
Dim NrTracks As Integer, Track As Integer
Dim TrackLength() As String

Answer = MsgBox("The audio CD must already be in the CD-rom drive." & vbCrLf & _
"No other software may use the audio CD.", vbExclamation + vbOKCancel)
If Answer <> vbOK Then Exit Sub

mciSendString "close all", 0, 0, 0
mciSendString "open cdaudio alias cd wait shareable", 0, 0, 0
mciSendString "status cd number of tracks wait", S, Len(S), 0
NrTracks = CInt(Mid$(S, 1, 2))

ReDim TrackLength(1 To NrTracks)
Dim i As Integer
For i = 1 To NrTracks
Cmd = "status cd length track " & i
mciSendString Cmd, S, Len(S), 0
TrackLength(i) = S
Next i

Counter = Counter + 1
Min = CInt(Mid$(TrackLength(Counter), 1, 2))
Sec = CInt(Mid$(TrackLength(Counter), 4, 2))
With ActiveCell.Cells(Counter, 1)
.Value = "00:" & Format(Min, "00") & ":" & Format(Sec, "00")
.NumberFormat = "[mm]:ss"
End With
If Counter = NrTracks Then Exit Do

mciSendString "close all", 0, 0, 0

End Sub
In the Visual Basic Editor:
Insert > Module
Paste the code.

Go back to Excel (use tab on Windows' Task bar) or close the Visual Basic Editor.
Put an audio CD in your CD ROM
Select any cell (suggest a cell on row 1 for this try out)
Then...... Tools > Macro > Macros (or Alt F8)
With your macro selected click .
You can copy the cells and paste into any text document.
Save the workbook for use next time.

credits : NFT team

No comments:

Post a Comment