This code enumerates all the .gif files in My Pictures and places the file name and gif version label in an Excel spreadsheet.
Option Explicit
Dim myShell, sendToFolder, myPicturesPath, myShortcut
Dim fso,myFolder, myFile, fileName, comment, myExcel
Dim myWorkbook, myRow, mySheet
' Find "My Pictures"
Set myShell = CreateObject("WScript.Shell")myPicturesPath = myShell.SpecialFolders("MyDocuments") & "\My Pictures"
' Open "My Pictures" as a folder so we can see
' which files are inside it
Set fso=CreateObject("Scripting.FileSystemObject")
Set myFolder=fso.GetFolder(myPicturesPath)
' Set Up Excel To receive The Data
Set myExcel=CreateObject("Excel.Application")
Set myWorkBook=myExcel.WorkBooks.Add
Set mySheet=myWorkBook.Sheets(1)
myRow=2
mySheet.Cells(1,1).Value="Name"
mySheet.Cells(1,2).Value="GIF Type"
myExcel.Visible=TRUE
' Loop through each file found and see
' if its file extension is .gif
' If a file is a .gif file then call our function
' which opens it as a binary file and reads the
' version label
for each myFile in myFolder.Files
fileName=myFile.name
fileName=Lcase(fileName)
if Right(fileName,4)=".gif" then
' Read the version label
comment=GetGifComment(myFile.path)
' Place the data in the spreadsheet
mySheet.Cells(myRow,1).Value=fileName
mySheet.Cells(myRow,2).Value=comment
' Step down to the next Row
myRow=myRow+1
end if
next
' Make the spreadsheet look a bit nicer
With mySheet.Range("A1:B1").Font
.FontStyle = "Bold"
.Size = 12
End With
mySheet.Columns(1).Autofit
mySheet.Columns(2).Autofit
'Script ends here
Function GetGifComment(gifFilePath)
dim inStream,buff,commentLen,commentStr,myIndex
dim myByte,myByteValue,myCharacter
set inStream=WScript.CreateObject("ADODB.Stream")
inStream.Open
inStream.type=1
inStream.LoadFromFile gifFilePath
buff=inStream.Read()
inStream.Close
commentStr=""
for myIndex = 1 to 6
' Extract 1 byte from the buffer
myByte = MidB(buff,myIndex,1)
' Gets its numeric value
myByteValue = AscB(myByte)
' Convert that numeric value into a character
myCharacter = Chr(myByteValue)
' Append that character to the string
commentStr = commentStr & myCharacter
next
GetGifComment = commentStr
End Function
[Via]