Попытка использовать объект Shell и FileSystemObject в VBScript для манипулирования файлами
Я пытаюсь рекурсивно пройтись по сотням каталогов и тысячам файлов JPG, чтобы отсортировать файлы в новых папках по дате. До сих пор я мог по отдельности GetDetailsOf файлов, используя объект Shell NameSpace, и я также могу рекурсивно перебирать каталоги с помощью FileSystemObject. Однако, когда я пытаюсь соединить их в функции и т. Д., Я ничего не получаю, когда пытаюсь получить атрибут DateTaken из фотографии.
Вот мой код до сих пор:
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
1 ответ
Ошибка "Subscript out of range" при доступе к arrDate(0) вызвана тем, что arrDate пуст (UBound(arrDate) == -1). Поскольку разделение на непустую строку вернет массив, даже если разделитель не найден, а попытка разделения на ноль вызовет ошибку "Недопустимое использование пустого значения", мы можем быть уверены, что strFileNameDate равен "".
Возможная причина этого:
- Индекс "Date Picture Taken" - 25 (XP), а не 12 (Win 7) - или что-либо еще, что пришло в голову мистеру Гейтсу для Win 8.
- Свойство DPT не заполнено.
- Ваша функция очистки испортила это.
Вы должны проверить на strFileNameDate, содержащую правильную дату, и решить, куда поместить файлы без действительного DPT.
PS Вместо того, чтобы делать рекурсивные циклы, вы должны рассмотреть возможность использования
dir /s/b path\*.jpg > pictures.txt
и обработать этот файл.