Extract only JPEGs from a folder to a CSV file using VBS

Question

I am trying to create a list in a CSV file with the full path name of photos within a folder. Here is my code:

Dim fso, folder, files, OutputFile
Dim strPath
 
' Create a FileSystemObject  
Set fso = CreateObject("Scripting.FileSystemObject")
 
' Define folder we want to list files from
strPath = "C:\Users\span\Desktop\PluripostageIssue\SD105-22\PHOTOS"
 
Set folder = fso.GetFolder(strPath)
Set files = folder.Files

' Create CSV file to output test data
Set OutputFile = fso.CreateTextFile("ScriptOutput.csv", True)
 
' Loop through each file  
For each item In files
 
  ' Output file properties to a text file
  OutputFile.WriteLine(item.Path)

Next
 
' Close text file
OutputFile.Close

With this code, I am able to get ALL files from the folder - however, I just want the JPEGs; I cannot figure out how to filter for just certain files. How can I manage this ?

Thank you !

Answer 1

Refer to FileSystemObject.GetExtensionName Method

---

You can write this :

For each item In files
    If Lcase(fso.GetExtensionName(item.Path)) = "jpg" OR _
        Lcase(fso.GetExtensionName(item.Path)) = "jpeg" Then
        OutputFile.WriteLine(item.Path)
    End If
Next

---

Or Refer to this solution Scan folder and list only image files with vbscript using Dictionary Object to add extension as filter :

---

Option Explicit
Const Title = "Extracting only JPEG from a folder to a CSV file"
Const Time2Wait = 4
Dim fso,ws, folder, files, OutputFile,CSV_File
Dim strPath,Extensions,item

' Create a FileSystemObject  
Set fso = CreateObject("Scripting.FileSystemObject")
' Create wscript shell Object
Set ws  = CreateObject("wscript.shell")

' Define folder we want to list files from
strPath = "C:\Users\span\Desktop\PluripostageIssue\SD105-22\PHOTOS"

' Check first if this folder exists before proceeding anything in this script
If Not fso.FolderExists(strPath) Then
    ws.Popup "WARNING ! ! !" & vbCrlf &_
    chr(34) & strPath & chr(34) & " does not exists !",_
    Time2Wait,Title,vbExclamation+vbSystemModal
    Wscript.Quit(1)
End If

Set folder = fso.GetFolder(strPath)
Set files = folder.Files

' Create CSV file to output test data
CSV_File = Left(Wscript.ScriptFullName,InstrRev(Wscript.ScriptFullName, ".")) & "csv"
Set OutputFile = fso.CreateTextFile(CSV_File,True)
Set Extensions = CreateObject("Scripting.Dictionary")
' Here We can add what extensions we are looking for as filter
Call Add_Filter("jpg")
Call Add_Filter("jpeg")
' If you want to add another extensions filter like png or other ....
' Call Add_Filter("png")

For Each item In files
    If Extensions.Exists(fso.GetExtensionName(item)) Then
        OutPutFile.WriteLine(item.Path)
    End If
Next

' Close text file
OutputFile.Close
ws.Popup Title & " is Done",Time2Wait,Title,vbInformation+vbSystemModal
ws.run "Excel "& chr(34) & CSV_File & chr(34)

Set Extensions = Nothing
Set OutputFile = Nothing
Set fso = Nothing
Set ws  = Nothing

'----------------------------------------------------
Sub Add_Filter(Ext)
'Make lookups case-insensitive
    Extensions.CompareMode = 1
    If Not Extensions.Exists(Ext) Then
        Extensions.Add Ext,True
    End If
End Sub
'----------------------------------------------------