I have this code which is successfully returning the 0-5 items of meta data. However, the dates are returning as mixed US and UK formats... I need to enforce Cdate or something similar to get the dates to all read as UK date. (DD/MM/YY) I have usually used Cdate for other things, but unsure how to get it to work....
Code:
Dim sFile As Object, obja
'Create Shell Object & NameSpace
Set oShell = CreateObject("Shell.Application")
Set oDir = oShell.Namespace("FILEPATH")
ActiveSheet.Cells.ClearContents
'Loop thru each File/Folder inside Root Directory
iRow = 1
For Each sFile In oDir.Items
iRow = iRow 1
'Loop thru Each Property
For i = 0 To 5
'Get File Property Name & Value
obja = oDir.GetDetailsOf(sFile, i)
If obja <> "" Then
iRow = iRow 1
'Enter File Property to Sheet
ActiveSheet.Range("A" & iRow) = oDir.GetDetailsOf(oDir, i)
ActiveSheet.Range("B" & iRow) = obja
End If
Next
Next
MsgBox "Process Completed"
End Sub
CodePudding user response:
For the date properties split the string into day,month,year,hour,minute and then recreate the date with DateSerial() and TimeSerial().
Option Explicit
Sub files()
Dim sFile As Object, obja, oShell, oDir
Dim iRow As Long, i As Long
Dim sValue, sName As String
Dim arDT, arDMY, arHMS, dt As Date
'Create Shell Object & NameSpace
Set oShell = CreateObject("Shell.Application")
Set oDir = oShell.Namespace("C:\temp\so\data")
ActiveSheet.Cells.ClearContents
'Loop thru each File/Folder inside Root Directory
iRow = 1
For Each sFile In oDir.Items
iRow = iRow 1
'Loop thru Each Property
For i = 0 To 5
sName = oDir.GetDetailsOf(oDir, i)
sValue = oDir.GetDetailsOf(sFile, i)
If sValue <> "" Then
iRow = iRow 1
Range("A" & iRow) = sName
If sName Like "Date*" Then
' sValue is dd/mm/yyyy hh:mm
arDT = Split(sValue, " ")
arDMY = Split(arDT(0), "/")
arHMS = Split(arDT(1), ":")
dt = DateSerial(arDMY(2), arDMY(1), arDMY(0)) _
TimeSerial(arHMS(0), arHMS(1), 0)
Range("B" & iRow).NumberFormat = "dd/mm/yy hh:mm"
Range("B" & iRow) = dt
Else
Range("B" & iRow) = sValue
End If
End If
Next
Next
MsgBox "Process Completed"
End Sub
