Home > OS >  Enforcing Cdate in VBA Excel when retrieving Meta Data
Enforcing Cdate in VBA Excel when retrieving Meta Data

Time:11-30

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
  • Related