Trying to convert iso 8601 datetime into real date time in excel vial vba

Question

I have found that how to convert this 2020-10-06T16:19:00 through Formula that is:

=DATEVALUE(MID(A1,1,10))+TIMEVALUE(MID(A1,12,8))

But i am trying to do this via VBA to apply it in whole column. Here is the VBA Examples

and i tried this:

Public Function UTCToLocalTime(dteTime As Date) As Date
  Dim infile As FILETIME
  Dim outfile As FILETIME
  Dim insys As SYSTEMTIME
  Dim outsys As SYSTEMTIME

  insys.wYear = CInt(Year(dteTime))
  insys.wMonth = CInt(Month(dteTime))
  insys.wDay = CInt(Day(dteTime))
  insys.wHour = CInt(Hour(dteTime))
  insys.wMinute = CInt(Minute(dteTime))
  insys.wSecond = CInt(Second(dteTime))

  Call SystemTimeToFileTime(insys, infile)
  Call FileTimeToLocalFileTime(infile, outfile)
  Call FileTimeToSystemTime(outfile, outsys)

  UTCToLocalTime = CDate(outsys.wDay & "/" & _
    outsys.wMonth & "/" & _
    outsys.wYear & " " & _
    outsys.wHour & ":" & _
    outsys.wMinute & ":" & _
    outsys.wSecond)
  End Function

But receiving an error: Your help will be appreciated.

Sub ChangeFormat()

Dim sh As Worksheet
Dim Tuming As String
Dim LastRow As Long

Set ws = Sheet43
LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
ws.Range("C2:C" & LastRow).NumberFormat = "m/d/yyyy h:mm"

Tuming = "2020-10-06T16:19:00"

Debug.Print UTCToLocalTime(Tuming)

End Sub

Answer 1

The safest way is to split the string in parts and put it together using the DateSerial and TimeSerial method.

Option Explicit

Public Sub example()
    Range("A1").Value = ConvertISO8601StringToDate("2020-10-06T16:19:00")
    Range("A1").NumberFormat = "m/d/yyyy h:mm"
End Sub

Public Function ConvertISO8601StringToDate(ByVal InputString As String) As Date
    
    Dim DatePart As Date
    DatePart = DateSerial(Left$(InputString, 4), Mid$(InputString, 6, 2), Mid$(InputString, 9, 2))
    
    Dim TimePart As Date
    TimePart = TimeSerial(Mid$(InputString, 12, 2), Mid$(InputString, 15, 2), Mid$(InputString, 18, 2))
    
    
    ConvertISO8601StringToDate = DatePart + TimePart
End Function

To convert an entire range use arrays for fast processing:

Public Sub ConvertRange()
    Dim RangeToConvert As Range  ' define range
    Set RangeToConvert = ThisWorkbook.Worksheets("Sheet1").Range("A1:A13")
    
    Dim DataArray() As Variant  ' convert range into array for fast processing
    DataArray = RangeToConvert.Value
    
    ' loop throug array data
    Dim iRow As Long
    For iRow = LBound(DataArray, 1) To UBound(DataArray, 1)
        Dim iCol As Long
        For iCol = LBound(DataArray, 2) To UBound(DataArray, 2)
            
            ' convert iso8601 conform strings and leave the rest unchanged
            Dim DateVal As Date
            On Error Resume Next
                DateVal = ConvertISO8601StringToDate(DataArray(iRow, iCol))
                If Err.Number = 0 Then  ' only convert iso8601 strings
                    DataArray(iRow, iCol) = DateVal
                End If
            On Error GoTo 0
        Next iCol
    Next iRow
    
    ' write array data back to sheet
    RangeToConvert.Value = DataArray
End Sub

---

More powerful function with RegEx that can convert all the ISO8601 defined formats:

The output of the timezoned times is converted UTC+00:00. So if that needs to be in any other zone it needs to be converted after that. For example into the comuters timezone.

For dates that have no day specified like YYYY, YYYY-MM or YYYY-Www always the first day of that period is asumed. So for example 2004-W28 gives the beginning of that week as date 2004-07-05 to get the end of that week you just need to add +6 to the beginning. Also 2004-07 will assume the beginning of the month 2004-07-01. And the year 2004 will be converted to the date 2004-01-01.

Public Function ConvDateTime(ByVal InVal As String) As Date
    Dim SplitDateTime() As String
    SplitDateTime = Split(InVal, "T")
    
    ConvDateTime = ConvDate(SplitDateTime(0)) + ConvTime(SplitDateTime(1))
End Function

Public Function ConvDate(ByVal InVal As String) As Date
    Dim RetVal As Variant
    
    Dim RegEx As Object
    Set RegEx = CreateObject("VBScript.RegExp")
    
    With RegEx
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
    End With
    
    RegEx.Pattern = "^(\d{4})-?(\d{2})?-?(\d{2})?$|^(\d{4})-?W(\d{2})?-?(\d)?$|^(\d{4})-?(\d{3})$"
    Dim Match As Object
    Set Match = RegEx.Execute(InVal)
    
    If Match.Count <> 1 Then Exit Function
    With Match(0)
        If Not IsEmpty(.SubMatches(0)) Then
            'YYYY-MM-DD
            If IsEmpty(.SubMatches(1)) Then  'YYYY
                RetVal = DateSerial(CInt(.SubMatches(0)), 1, 1)
            ElseIf IsEmpty(.SubMatches(2)) Then 'YYYY-MM
                RetVal = DateSerial(CInt(.SubMatches(0)), CInt(.SubMatches(1)), 1)
            Else 'YYYY-MM-DD
                RetVal = DateSerial(CInt(.SubMatches(0)), CInt(.SubMatches(1)), CInt(.SubMatches(2)))
            End If
        ElseIf Not IsEmpty(.SubMatches(3)) Then
            'YYYY-Www-D
            RetVal = DateSerial(CInt(.SubMatches(3)), 1, 4) '4th of jan is always week 1
            RetVal = RetVal - Weekday(RetVal, 2) 'subtract the weekday number of 4th of jan
            RetVal = RetVal + 7 * (CInt(.SubMatches(4)) - 1) 'add 7 times the (weeknumber - 1)
            
            If IsEmpty(.SubMatches(5)) Then 'YYYY-Www
                RetVal = RetVal + 1 'choose monday of that week
            Else 'YYYY-Www-D
                RetVal = RetVal + CInt(.SubMatches(5)) 'choose day of that week 1-7 monday to sunday
            End If
        Else
            'YYYY-DDD
            RetVal = DateSerial(CInt(.SubMatches(6)), 1, 1) + CInt(.SubMatches(7)) - 1
        End If
    End With
    
    ConvDate = RetVal
End Function

Public Function ConvTime(ByVal InVal As String) As Date
    Dim RetVal As Variant
    
    Dim RegEx As Object
    Set RegEx = CreateObject("VBScript.RegExp")
    
    With RegEx
        .Global = True
        .MultiLine = False
        .IgnoreCase = False
    End With
    
    RegEx.Pattern = "^(\d{2}):?(\d{2})?:?(\d{2})?(\+|\-|Z)?(\d{2})?:?(\d{2})?$|^(\d{2}):(\d{2}):(\d{2}\.?\,?\d{4})?(\+|\-|Z)?(\d{2})?:?(\d{2})?$"
    Dim Match As Object
    Set Match = RegEx.Execute(InVal)
    
    If Match.Count <> 1 Then Exit Function
    With Match(0)
        If Not IsEmpty(.SubMatches(0)) Then
            'hh:mm:ss
            If IsEmpty(.SubMatches(1)) Then  'hh
                RetVal = TimeSerial(CInt(.SubMatches(0)), 0, 0)
            ElseIf IsEmpty(.SubMatches(2)) Then  'hh:mm
                RetVal = TimeSerial(CInt(.SubMatches(0)), CInt(.SubMatches(1)), 0)
            Else 'hh:mm:ss
                RetVal = TimeSerial(CInt(.SubMatches(0)), CInt(.SubMatches(1)), CInt(.SubMatches(2)))
            End If
            
            If Not IsEmpty(.SubMatches(3)) Then
                If Not .SubMatches(3) = "Z" Then
                    If Not IsEmpty(.SubMatches(4)) Then
                        RetVal = DateAdd("h", -1& * CDbl(.SubMatches(3) & .SubMatches(4)), RetVal)
                    End If
                    If Not IsEmpty(.SubMatches(5)) Then
                        RetVal = DateAdd("n", -1& * CDbl(.SubMatches(3) & .SubMatches(5)), RetVal)
                    End If
                End If
            End If
            
        Else
            'hh:mm:ss,f
            Dim Milliseconds As String
            Milliseconds = .SubMatches(8)
            Milliseconds = Replace$(Milliseconds, ",", Application.DecimalSeparator)
            Milliseconds = Replace$(Milliseconds, ".", Application.DecimalSeparator)
            
            RetVal = TimeSerial(CInt(.SubMatches(6)), CInt(.SubMatches(7)), 0)
            RetVal = RetVal + (CDbl(Milliseconds) / 60 / 60 / 24) ' TimeSerial does not support milliseconds
        End If
    End With
    
    ConvTime = RetVal
End Function