Trying to use Shell object and FileSystemObject in VBScript for file manipulation

Question

I am trying to recursively loop through hundreds of directories, and thousands of JPG files to gather sort the files in new folders by date. So far, I am able to individually GetDetailsOf the files using the Shell NameSpace object, and I am also able to recursively loop through directories using the FileSystemObject. However, when I try to put them together in functions, etc, I am getting nothing back when I try to get the DateTaken attribute from the photo.

Here is my code so far:

sFolderPathspec = "C:\LocationOfFiles"

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objDir = objFSO.GetFolder(sFolderPathspec)

Dim arrFiles()


getInfo(objDir)

Sub getInfo(pCurrentDir)
    fileCount = 0
    For Each strFileName In pCurrentDir.Files
        fileCount = fileCount + 1
    Next

    ReDim arrFiles(fileCount,2) 

    i=0
    For Each aItem In pCurrentDir.Files

        wscript.Echo aItem.Name
        arrFiles(i,0) = aItem.Name
        strFileName = aItem.Name
        strDir = pCurrentDir.Path
        wscript.echo strDir
        dateVar = GetDatePictureTaken(strFileName, strDir)  
        'dateVar = Temp2 & "_" & Temp3 & "_" & Temp1
        arrFiles(i,1) = dateVar
        WScript.echo i & "." & "M:" & monthVar & " Y:" & yearVar
        WScript.echo i & "." & strFileName & " : " & arrFiles(i,1) & " : " & dateVar
        i=i+1
    Next

    For Each aItem In pCurrentDir.SubFolders
       'wscript.Echo aItem.Name & " passing recursively"
       getInfo(aItem)
    Next

End Sub

Function GetDatePictureTaken(strFileName, strDir)

    Set objShell = CreateObject ("Shell.Application")
    Set objCurrFolder = objShell.Namespace(strDir)

    'wscript.Echo cstr(objCurrFolder.GetDetailsOf(strFileName, 12))

    strFileNameDate = cstr(objCurrFolder.GetDetailsOf(strFileName, 12))
    strFileNameDate = CleanNonDisplayableCharacters(strFileNameDate)
    arrDate = split(strFileNameDate, "/")
    '''FAILS HERE WITH A SUBSCRIPT OUT OF RANGE ERROR SINCE IT GETS NULL VALUES BACK FROM THE GET DETAILS OF FUNCTION'''
    monthVar = arrDate(0)
    yearVar = arrDate(1)
    dayVar = arrDate(2)

    GetDatePictureTaken = monthVar & "\" & dayVar & "\" & yearVar

End Function


Function CleanNonDisplayableCharacters(strInput)

      strTemp = ""
      For i = 1 to len(strInput)
          strChar = Mid(strInput,i,1)
          If Asc(strChar) < 126 and not Asc(strChar) = 63 Then
              strTemp = strTemp & strChar
          End If
      Next
      CleanNonDisplayableCharacters = strTemp

End Function

Ekkehard.Horner Ekkehard.Horner · Accepted Answer · 2013-01-10T09:05:37

The "Subscript out of range" error when accessing arrDate(0) is caused by arrDate being empty (UBound(arrDate) == -1). As a Split on a non-empty string will return an array, even if the separator is not found, and an attempt to Split Null will raise an "Invalid use of Null" error, we can be sure that strFileNameDate is "".

Possible reason for that:

The index of "Date Picture Taken" is 25 (XP) and not 12 (Win 7) - or whatever came to Mr. Gates' mind for Win 8.
The DPT property is not filled in.
Your cleaning function messed it up.

You have to test for strFileNameDate containing a valid date and decide where to put the files without a valid DPT.

P.S. Instead of doing the recursive loopings, you should consider to use

dir /s/b path\*.jpg > pictures.txt

and to process that file.

Trying to use Shell object and FileSystemObject in VBScript for file manipulation

1 Answers