CodeItBetter Programming Another VB Programming Blog

'MultiMedia - MP3 summary Properties
'This writes data to summary properties of .wma and .mp3 files, or files with a similar properties
'layout you can construct this to batch process a bunch of mp3, with extra information
'Note: you must select advanced option in summary properties tab as default view when properties
'dialog opens. This is a way to write properties, as ms dsofile.exe, from microsoft only writes to
'office documents if anyone knows of a control to do this, let me know also from other (API):
'opens file properties dialog from file name!

Declare Function ShellExecuteEX Lib "shell32.dll" Alias "ShellExecuteEx" _
    (SEI As SHELLEXECUTEINFO) As Long
Const SEE_MASK_INVOKEIDLIST = &HC
Const SEE_MASK_NOCLOSEPROCESS = &H40
Const SEE_MASK_FLAG_NO_UI = &H400
Type SHELLEXECUTEINFO
    cbSize As Long
    fMask As Long
    hWnd As Long
    lpVerb As String
    lpFile As String
    lpParameters As String
    lpDirectory As String
    nShow As Long
    hInstApp As Long
    lpIDList As Long
    lpClass As String
    hkeyClass As Long
    dwHotKey As Long
    hIcon As Long
    hProcess As Long
End Type
 
Public Function ShowFileProp(ByVal FileName As String, aForm As Form) As Long
    'open the file properties for the filename
    'if return <=32 error occured
    Dim SEI As SHELLEXECUTEINFO
    Dim r As Long
    If FileName = "" Then
        ShowFileProp = 0
        Exit Function
    End If
    With SEI
        .cbSize = Len(SEI)
        .fMask = SEE_MASK_NOCLOSEPROCESS Or SEE_MASK_INVOKEIDLIST Or SEE_MASK_FLAG_NO_UI
        .hWnd = aForm.hWnd
        .lpVerb = "properties"
        .lpFile = FileName
        .lpParameters = vbNullChar
        .lpDirectory = vbNullChar
        .nShow = 0
        .hInstApp = 0
        .lpIDList = 0
    End With
    r = ShellExecuteEX(SEI)
    ShowFileProp = SEI.hInstApp
End Function
 
'Code:

Private Sub Command1_Click()
    'This is your go button, it starts the timer
    ' all code is run from the timer10 (interval 2500)
    'enabled = false
    ' I set this at 2.5 seconds, to make sure the properties dialog
    ' had time to receive focus, so keys would be sent to it, and not form1
    Timer10.Enabled = True
End Sub
 
Private Sub Form_Load()
    Timer10.Enabled = False
End Sub
 
Private Sub GetFilePropertiesDialog()
    x = ShowFileProp("c:\1.wma", Form1)
End Sub
 
Sub holdit()
    ' I put this pause time, because sometimes sendkeys
    ' goes much faster than the wimdow will respond, and you get
    ' a keystroke error because the window is slower than the
    ' keys being sent - it allows the window to recieve
    ' all the key data, you can place it anywhere
    ' where you want to allow time for the data to reach
    ' the place it needs to go
    Dim start
    Dim PauseTime
    PauseTime = 3
    start = Timer
    Do While Timer < start + PauseTime
        DoEvents
    Loop
End Sub
 
Private Sub Timer10_Timer()
    ' This writes data to summary properties of .wma and .mp3
    ' files, or files with a similar properties layout
    ' you can construct this to batch process a bunch of mp3, with
    ' extra information
    ' Note: you must select advanced option in summary properties tab
    ' This is a way to write properties, as ms dsofile.exe, from microsoft
    ' only writes to office documents
    Dim intTrackNumber As Integer
    'On Error Resume Next
    intTrackNumber = intTrackNumber + 1
    TextTrack.Text = intTrackNumber
    GetFilePropertiesDialog
    holdit
 
    SendKeys "^{PGDN}""^{PGDN}"
 
    SendKeys "{HOME}"
    SendKeys TextArtist.Text
    SendKeys "{ENTER}"
    SendKeys "{DOWN}"
    SendKeys TextAlbum.Text
    SendKeys "{ENTER}"
    SendKeys "{DOWN}"
    SendKeys TextYear.Text
    SendKeys "{ENTER}"
    SendKeys "{DOWN}"
    SendKeys TextTrack.Text
    SendKeys "{ENTER}"
    SendKeys "{DOWN}"
    SendKeys TextGenre.Text
    SendKeys "{ENTER}"
    SendKeys "{DOWN}"
    SendKeys TextLyrics.Text
    SendKeys "{ENTER}"
    SendKeys "{DOWN}"
    SendKeys TextTitle.Text
    SendKeys "{ENTER}"
    SendKeys "{DOWN}"
    SendKeys TextComments.Text
    SendKeys "{ENTER}"
    'SendKeys "{DOWN}"
    holdit
    SendKeys "{TAB}"
    SendKeys "{TAB}"
    SendKeys "{ENTER}"
    holdit
    Timer10.Enabled = False
End Sub