I put together this that is rather tailored to your request. You can point
it at a folder and it will pull out only the media file types (graphic,
video, audio) even if there are other types in that folder. You can put this
code into a workbook of your own or you can download a working file at (click
link and save to your hard drive)
http://www.jlathamsite.com/uploads/ListMediaFilesInSelectedFolder.xls
to put the code in a workbook of your own, press [Alt]+[F11] to open the VB
Editor, choose Insert | Module from the menu and then copy this code and
paste it into the module. Close it and run from Tools | Macro | Macros...
Sub GetMediaFileNames()
Dim basicPath As String
Dim anyFileName As String
Dim fileExt As String
Dim rOffset As Long
Dim baseCell As Range
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
If .SelectedItems.Count > 0 Then
basicPath = .SelectedItems(1) & "\"
Else
Exit Sub ' user cancelled
End If
End With
If Val(Left(Application.Version, 2)) < 12 Then
'in pre-2007 version of Excel
rOffset = Range("A" & Rows.Count).End(xlUp). _
Offset(1, 0).End(xlUp).Row - 1
Else
'in Excel 2007 (or later?)
rOffset = Range("A" & Rows.CountLarge).End(xlUp). _
Offset(1, 0).End(xlUp).Row - 1
End If
Set baseCell = Range("A1")
Application.ScreenUpdating = False ' improves speed
anyFileName = Dir$(basicPath & "*.*", vbNormal)
Do While anyFileName <> ""
If InStr(anyFileName, ".") Then
fileExt = UCase(Trim(Right(anyFileName, Len(anyFileName) - _
InStrRev(anyFileName, "."))))
Select Case fileExt
'graphic files (not video)
Case "JPG", "TIF", "TIFF", "BMP", "GIF", "PNG"
baseCell.Offset(rOffset, 0) = anyFileName
rOffset = rOffset + 1
'windows media file extensions
Case "WMV", "WMA", "WVX", "WAX", _
"ASF", "ASX", "WMS", "WMZ", "WMD"
baseCell.Offset(rOffset, 0) = anyFileName
rOffset = rOffset + 1
'other media file extensions
'K-Jofol
Case "WAV", "MP3", "VQF", "AAC"
baseCell.Offset(rOffset, 0) = anyFileName
rOffset = rOffset + 1
'Liquid Audio
Case "LAV"
baseCell.Offset(rOffset, 0) = anyFileName
rOffset = rOffset + 1
'(more) Microsoft Media
Case "WAV", "MIDI", "SND"
baseCell.Offset(rOffset, 0) = anyFileName
rOffset = rOffset + 1
'ModPlug and WinKaraoke
Case "MOD", "KAR"
baseCell.Offset(rOffset, 0) = anyFileName
rOffset = rOffset + 1
'Video types
Case "MPEG", "AVI", "MOV", "VDO", "VIVO"
baseCell.Offset(rOffset, 0) = anyFileName
rOffset = rOffset + 1
'QuickTime
Case "3DMF", "3GPP", "AMC", "AMR", "DLS", "QCP", "SDP", _
"SDV", "SF2", "SGI", "SMIL"
baseCell.Offset(rOffset, 0) = anyFileName
rOffset = rOffset + 1
'iTunes
Case "M4A", "M4B", "M4P", "M4V"
baseCell.Offset(rOffset, 0) = anyFileName
rOffset = rOffset + 1
'other types
Case "XDM", "RAM", "RM", "AIFF", "DV", "AU", "FLA", "VDU", _
"M3U", "VR"
baseCell.Offset(rOffset, 0) = anyFileName
rOffset = rOffset + 1
'non media file encountered
Case Else
'do nothing
End Select
anyFileName = Dir$() ' get next filename
End If
Loop
Application.ScreenUpdating = True
End Sub