尝试在excel小瓶vba中将iso 8601日期时间转换为实时日期时间

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