├── .editorconfig ├── .gitattributes ├── .gitignore ├── LICENSE ├── README.md ├── UtcConverter.bas └── specs ├── Specs.bas └── VBA-UTC - Specs.xlsm /.editorconfig: -------------------------------------------------------------------------------- 1 | [*] 2 | indent_style = space 3 | indent_size = 2 4 | end_of_line = lf 5 | trim_trailing_whitespace = true 6 | insert_final_newline = true 7 | charset = utf-8 8 | 9 | [*.{bas,cls}] 10 | indent_size = 4 11 | end_of_line = crlf 12 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | # CRLF -> LF by default, but not for modules or classes (especially classes) 2 | * text=auto 3 | *.bas text eol=crlf 4 | *.cls text eol=crlf 5 | 6 | # Standard to msysgit 7 | *.doc diff=astextplain 8 | *.DOC diff=astextplain 9 | *.docx diff=astextplain 10 | *.DOCX diff=astextplain 11 | *.dot diff=astextplain 12 | *.DOT diff=astextplain 13 | *.pdf diff=astextplain 14 | *.PDF diff=astextplain 15 | *.rtf diff=astextplain 16 | *.RTF diff=astextplain 17 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Ignore temporary Excel files 2 | */~$* 3 | 4 | # Ignore scratch work and other files 5 | _scratch 6 | .DS_Store -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2017-2019 Tim Hall 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # VBA-UTC 2 | 3 | UTC and ISO 8601 date conversion and parsing for VBA (Windows and Mac Excel, Access, and other Office applications). 4 | 5 | Tested in Excel 2016 for Windows and Mac, but should apply to Windows Excel 2007+. 6 | 7 | 8 | Donate 9 | 10 | 11 | # Example 12 | 13 | ```VB.net 14 | ' Timezone: EST (UTC-5:00), DST: True (+1:00) -> UTC-4:00 15 | Dim LocalDate As Date 16 | Dim UtcDate As Date 17 | Dim Iso As String 18 | 19 | LocalDate = DateValue("Jan. 2, 2003") + TimeValue("4:05:06 PM") 20 | UtcDate = UtcConverter.ConvertToUtc(LocalDate) 21 | 22 | Debug.Print VBA.Format$(UtcDate, "yyyy-mm-ddTHH:mm:ss.000Z") 23 | ' -> "2003-01-02T20:05:06.000Z" 24 | 25 | Iso = UtcConverter.ConvertToIso(LocalDate) 26 | Debug.Print Iso 27 | ' -> "2003-01-02T20:05:06.000Z" 28 | 29 | LocalDate = UtcConverter.ParseUtc(UtcDate) 30 | LocalDate = UtcConverter.ParseIso(Iso) 31 | 32 | Debug.Print VBA.Format$(LocalDate, "m/d/yyyy h:mm:ss AM/PM") 33 | ' -> "1/2/2003 4:05:06 PM" 34 | ``` 35 | -------------------------------------------------------------------------------- /UtcConverter.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "UtcConverter" 2 | '' 3 | ' VBA-UTC v1.0.6 4 | ' (c) Tim Hall - https://github.com/VBA-tools/VBA-UtcConverter 5 | ' 6 | ' UTC/ISO 8601 Converter for VBA 7 | ' 8 | ' Errors: 9 | ' 10011 - UTC parsing error 10 | ' 10012 - UTC conversion error 11 | ' 10013 - ISO 8601 parsing error 12 | ' 10014 - ISO 8601 conversion error 13 | ' 14 | ' @module UtcConverter 15 | ' @author tim.hall.engr@gmail.com 16 | ' @license MIT (http://www.opensource.org/licenses/mit-license.php) 17 | '' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' 18 | 19 | #If Mac Then 20 | 21 | #If VBA7 Then 22 | 23 | ' 64-bit Mac (2016) 24 | Private Declare PtrSafe Function utc_popen Lib "/usr/lib/libc.dylib" Alias "popen" _ 25 | (ByVal utc_Command As String, ByVal utc_Mode As String) As LongPtr 26 | Private Declare PtrSafe Function utc_pclose Lib "/usr/lib/libc.dylib" Alias "pclose" _ 27 | (ByVal utc_File As LongPtr) As LongPtr 28 | Private Declare PtrSafe Function utc_fread Lib "/usr/lib/libc.dylib" Alias "fread" _ 29 | (ByVal utc_Buffer As String, ByVal utc_Size As LongPtr, ByVal utc_Number As LongPtr, ByVal utc_File As LongPtr) As LongPtr 30 | Private Declare PtrSafe Function utc_feof Lib "/usr/lib/libc.dylib" Alias "feof" _ 31 | (ByVal utc_File As LongPtr) As LongPtr 32 | 33 | #Else 34 | 35 | ' 32-bit Mac 36 | Private Declare Function utc_popen Lib "libc.dylib" Alias "popen" _ 37 | (ByVal utc_Command As String, ByVal utc_Mode As String) As Long 38 | Private Declare Function utc_pclose Lib "libc.dylib" Alias "pclose" _ 39 | (ByVal utc_File As Long) As Long 40 | Private Declare Function utc_fread Lib "libc.dylib" Alias "fread" _ 41 | (ByVal utc_Buffer As String, ByVal utc_Size As Long, ByVal utc_Number As Long, ByVal utc_File As Long) As Long 42 | Private Declare Function utc_feof Lib "libc.dylib" Alias "feof" _ 43 | (ByVal utc_File As Long) As Long 44 | 45 | #End If 46 | 47 | #ElseIf VBA7 Then 48 | 49 | ' http://msdn.microsoft.com/en-us/library/windows/desktop/ms724421.aspx 50 | ' http://msdn.microsoft.com/en-us/library/windows/desktop/ms724949.aspx 51 | ' http://msdn.microsoft.com/en-us/library/windows/desktop/ms725485.aspx 52 | Private Declare PtrSafe Function utc_GetTimeZoneInformation Lib "kernel32" Alias "GetTimeZoneInformation" _ 53 | (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION) As Long 54 | Private Declare PtrSafe Function utc_SystemTimeToTzSpecificLocalTime Lib "kernel32" Alias "SystemTimeToTzSpecificLocalTime" _ 55 | (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION, utc_lpUniversalTime As utc_SYSTEMTIME, utc_lpLocalTime As utc_SYSTEMTIME) As Long 56 | Private Declare PtrSafe Function utc_TzSpecificLocalTimeToSystemTime Lib "kernel32" Alias "TzSpecificLocalTimeToSystemTime" _ 57 | (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION, utc_lpLocalTime As utc_SYSTEMTIME, utc_lpUniversalTime As utc_SYSTEMTIME) As Long 58 | 59 | #Else 60 | 61 | Private Declare Function utc_GetTimeZoneInformation Lib "kernel32" Alias "GetTimeZoneInformation" _ 62 | (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION) As Long 63 | Private Declare Function utc_SystemTimeToTzSpecificLocalTime Lib "kernel32" Alias "SystemTimeToTzSpecificLocalTime" _ 64 | (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION, utc_lpUniversalTime As utc_SYSTEMTIME, utc_lpLocalTime As utc_SYSTEMTIME) As Long 65 | Private Declare Function utc_TzSpecificLocalTimeToSystemTime Lib "kernel32" Alias "TzSpecificLocalTimeToSystemTime" _ 66 | (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION, utc_lpLocalTime As utc_SYSTEMTIME, utc_lpUniversalTime As utc_SYSTEMTIME) As Long 67 | 68 | #End If 69 | 70 | #If Mac Then 71 | 72 | #If VBA7 Then 73 | Private Type utc_ShellResult 74 | utc_Output As String 75 | utc_ExitCode As LongPtr 76 | End Type 77 | 78 | #Else 79 | 80 | Private Type utc_ShellResult 81 | utc_Output As String 82 | utc_ExitCode As Long 83 | End Type 84 | 85 | #End If 86 | 87 | #Else 88 | 89 | Private Type utc_SYSTEMTIME 90 | utc_wYear As Integer 91 | utc_wMonth As Integer 92 | utc_wDayOfWeek As Integer 93 | utc_wDay As Integer 94 | utc_wHour As Integer 95 | utc_wMinute As Integer 96 | utc_wSecond As Integer 97 | utc_wMilliseconds As Integer 98 | End Type 99 | 100 | Private Type utc_TIME_ZONE_INFORMATION 101 | utc_Bias As Long 102 | utc_StandardName(0 To 31) As Integer 103 | utc_StandardDate As utc_SYSTEMTIME 104 | utc_StandardBias As Long 105 | utc_DaylightName(0 To 31) As Integer 106 | utc_DaylightDate As utc_SYSTEMTIME 107 | utc_DaylightBias As Long 108 | End Type 109 | 110 | #End If 111 | 112 | ' ============================================= ' 113 | ' Public Methods 114 | ' ============================================= ' 115 | 116 | '' 117 | ' Parse UTC date to local date 118 | ' 119 | ' @method ParseUtc 120 | ' @param {Date} UtcDate 121 | ' @return {Date} Local date 122 | ' @throws 10011 - UTC parsing error 123 | '' 124 | Public Function ParseUtc(utc_UtcDate As Date) As Date 125 | On Error GoTo utc_ErrorHandling 126 | 127 | #If Mac Then 128 | ParseUtc = utc_ConvertDate(utc_UtcDate) 129 | #Else 130 | Dim utc_TimeZoneInfo As utc_TIME_ZONE_INFORMATION 131 | Dim utc_LocalDate As utc_SYSTEMTIME 132 | 133 | utc_GetTimeZoneInformation utc_TimeZoneInfo 134 | utc_SystemTimeToTzSpecificLocalTime utc_TimeZoneInfo, utc_DateToSystemTime(utc_UtcDate), utc_LocalDate 135 | 136 | ParseUtc = utc_SystemTimeToDate(utc_LocalDate) 137 | #End If 138 | 139 | Exit Function 140 | 141 | utc_ErrorHandling: 142 | Err.Raise 10011, "UtcConverter.ParseUtc", "UTC parsing error: " & Err.Number & " - " & Err.Description 143 | End Function 144 | 145 | '' 146 | ' Convert local date to UTC date 147 | ' 148 | ' @method ConvertToUrc 149 | ' @param {Date} utc_LocalDate 150 | ' @return {Date} UTC date 151 | ' @throws 10012 - UTC conversion error 152 | '' 153 | Public Function ConvertToUtc(utc_LocalDate As Date) As Date 154 | On Error GoTo utc_ErrorHandling 155 | 156 | #If Mac Then 157 | ConvertToUtc = utc_ConvertDate(utc_LocalDate, utc_ConvertToUtc:=True) 158 | #Else 159 | Dim utc_TimeZoneInfo As utc_TIME_ZONE_INFORMATION 160 | Dim utc_UtcDate As utc_SYSTEMTIME 161 | 162 | utc_GetTimeZoneInformation utc_TimeZoneInfo 163 | utc_TzSpecificLocalTimeToSystemTime utc_TimeZoneInfo, utc_DateToSystemTime(utc_LocalDate), utc_UtcDate 164 | 165 | ConvertToUtc = utc_SystemTimeToDate(utc_UtcDate) 166 | #End If 167 | 168 | Exit Function 169 | 170 | utc_ErrorHandling: 171 | Err.Raise 10012, "UtcConverter.ConvertToUtc", "UTC conversion error: " & Err.Number & " - " & Err.Description 172 | End Function 173 | 174 | '' 175 | ' Parse ISO 8601 date string to local date 176 | ' 177 | ' @method ParseIso 178 | ' @param {Date} utc_IsoString 179 | ' @return {Date} Local date 180 | ' @throws 10013 - ISO 8601 parsing error 181 | '' 182 | Public Function ParseIso(utc_IsoString As String) As Date 183 | On Error GoTo utc_ErrorHandling 184 | 185 | Dim utc_Parts() As String 186 | Dim utc_DateParts() As String 187 | Dim utc_TimeParts() As String 188 | Dim utc_OffsetIndex As Long 189 | Dim utc_HasOffset As Boolean 190 | Dim utc_NegativeOffset As Boolean 191 | Dim utc_OffsetParts() As String 192 | Dim utc_Offset As Date 193 | 194 | utc_Parts = VBA.Split(utc_IsoString, "T") 195 | utc_DateParts = VBA.Split(utc_Parts(0), "-") 196 | ParseIso = VBA.DateSerial(VBA.CInt(utc_DateParts(0)), VBA.CInt(utc_DateParts(1)), VBA.CInt(utc_DateParts(2))) 197 | 198 | If UBound(utc_Parts) > 0 Then 199 | If VBA.InStr(utc_Parts(1), "Z") Then 200 | utc_TimeParts = VBA.Split(VBA.Replace(utc_Parts(1), "Z", ""), ":") 201 | Else 202 | utc_OffsetIndex = VBA.InStr(1, utc_Parts(1), "+") 203 | If utc_OffsetIndex = 0 Then 204 | utc_NegativeOffset = True 205 | utc_OffsetIndex = VBA.InStr(1, utc_Parts(1), "-") 206 | End If 207 | 208 | If utc_OffsetIndex > 0 Then 209 | utc_HasOffset = True 210 | utc_TimeParts = VBA.Split(VBA.Left$(utc_Parts(1), utc_OffsetIndex - 1), ":") 211 | utc_OffsetParts = VBA.Split(VBA.Right$(utc_Parts(1), Len(utc_Parts(1)) - utc_OffsetIndex), ":") 212 | 213 | Select Case UBound(utc_OffsetParts) 214 | Case 0 215 | utc_Offset = TimeSerial(VBA.CInt(utc_OffsetParts(0)), 0, 0) 216 | Case 1 217 | utc_Offset = TimeSerial(VBA.CInt(utc_OffsetParts(0)), VBA.CInt(utc_OffsetParts(1)), 0) 218 | Case 2 219 | ' VBA.Val does not use regional settings, use for seconds to avoid decimal/comma issues 220 | utc_Offset = TimeSerial(VBA.CInt(utc_OffsetParts(0)), VBA.CInt(utc_OffsetParts(1)), Int(VBA.Val(utc_OffsetParts(2)))) 221 | End Select 222 | 223 | If utc_NegativeOffset Then: utc_Offset = -utc_Offset 224 | Else 225 | utc_TimeParts = VBA.Split(utc_Parts(1), ":") 226 | End If 227 | End If 228 | 229 | Select Case UBound(utc_TimeParts) 230 | Case 0 231 | ParseIso = ParseIso + VBA.TimeSerial(VBA.CInt(utc_TimeParts(0)), 0, 0) 232 | Case 1 233 | ParseIso = ParseIso + VBA.TimeSerial(VBA.CInt(utc_TimeParts(0)), VBA.CInt(utc_TimeParts(1)), 0) 234 | Case 2 235 | ' VBA.Val does not use regional settings, use for seconds to avoid decimal/comma issues 236 | ParseIso = ParseIso + VBA.TimeSerial(VBA.CInt(utc_TimeParts(0)), VBA.CInt(utc_TimeParts(1)), Int(VBA.Val(utc_TimeParts(2)))) 237 | End Select 238 | 239 | ParseIso = ParseUtc(ParseIso) 240 | 241 | If utc_HasOffset Then 242 | ParseIso = ParseIso - utc_Offset 243 | End If 244 | End If 245 | 246 | Exit Function 247 | 248 | utc_ErrorHandling: 249 | Err.Raise 10013, "UtcConverter.ParseIso", "ISO 8601 parsing error for " & utc_IsoString & ": " & Err.Number & " - " & Err.Description 250 | End Function 251 | 252 | '' 253 | ' Convert local date to ISO 8601 string 254 | ' 255 | ' @method ConvertToIso 256 | ' @param {Date} utc_LocalDate 257 | ' @return {Date} ISO 8601 string 258 | ' @throws 10014 - ISO 8601 conversion error 259 | '' 260 | Public Function ConvertToIso(utc_LocalDate As Date) As String 261 | On Error GoTo utc_ErrorHandling 262 | 263 | ConvertToIso = VBA.Format$(ConvertToUtc(utc_LocalDate), "yyyy-mm-ddTHH:mm:ss.000Z") 264 | 265 | Exit Function 266 | 267 | utc_ErrorHandling: 268 | Err.Raise 10014, "UtcConverter.ConvertToIso", "ISO 8601 conversion error: " & Err.Number & " - " & Err.Description 269 | End Function 270 | 271 | ' ============================================= ' 272 | ' Private Functions 273 | ' ============================================= ' 274 | 275 | #If Mac Then 276 | 277 | Private Function utc_ConvertDate(utc_Value As Date, Optional utc_ConvertToUtc As Boolean = False) As Date 278 | Dim utc_ShellCommand As String 279 | Dim utc_Result As utc_ShellResult 280 | Dim utc_Parts() As String 281 | Dim utc_DateParts() As String 282 | Dim utc_TimeParts() As String 283 | 284 | If utc_ConvertToUtc Then 285 | utc_ShellCommand = "date -ur `date -jf '%Y-%m-%d %H:%M:%S' " & _ 286 | "'" & VBA.Format$(utc_Value, "yyyy-mm-dd HH:mm:ss") & "' " & _ 287 | " +'%s'` +'%Y-%m-%d %H:%M:%S'" 288 | Else 289 | utc_ShellCommand = "date -jf '%Y-%m-%d %H:%M:%S %z' " & _ 290 | "'" & VBA.Format$(utc_Value, "yyyy-mm-dd HH:mm:ss") & " +0000' " & _ 291 | "+'%Y-%m-%d %H:%M:%S'" 292 | End If 293 | 294 | utc_Result = utc_ExecuteInShell(utc_ShellCommand) 295 | 296 | If utc_Result.utc_Output = "" Then 297 | Err.Raise 10015, "UtcConverter.utc_ConvertDate", "'date' command failed" 298 | Else 299 | utc_Parts = Split(utc_Result.utc_Output, " ") 300 | utc_DateParts = Split(utc_Parts(0), "-") 301 | utc_TimeParts = Split(utc_Parts(1), ":") 302 | 303 | utc_ConvertDate = DateSerial(utc_DateParts(0), utc_DateParts(1), utc_DateParts(2)) + _ 304 | TimeSerial(utc_TimeParts(0), utc_TimeParts(1), utc_TimeParts(2)) 305 | End If 306 | End Function 307 | 308 | Private Function utc_ExecuteInShell(utc_ShellCommand As String) As utc_ShellResult 309 | #If VBA7 Then 310 | Dim utc_File As LongPtr 311 | Dim utc_Read As LongPtr 312 | #Else 313 | Dim utc_File As Long 314 | Dim utc_Read As Long 315 | #End If 316 | 317 | Dim utc_Chunk As String 318 | 319 | On Error GoTo utc_ErrorHandling 320 | utc_File = utc_popen(utc_ShellCommand, "r") 321 | 322 | If utc_File = 0 Then: Exit Function 323 | 324 | Do While utc_feof(utc_File) = 0 325 | utc_Chunk = VBA.Space$(50) 326 | utc_Read = CLng(utc_fread(utc_Chunk, 1, Len(utc_Chunk) - 1, utc_File)) 327 | If utc_Read > 0 Then 328 | utc_Chunk = VBA.Left$(utc_Chunk, CLng(utc_Read)) 329 | utc_ExecuteInShell.utc_Output = utc_ExecuteInShell.utc_Output & utc_Chunk 330 | End If 331 | Loop 332 | 333 | utc_ErrorHandling: 334 | utc_ExecuteInShell.utc_ExitCode = CLng(utc_pclose(utc_File)) 335 | End Function 336 | 337 | #Else 338 | 339 | Private Function utc_DateToSystemTime(utc_Value As Date) As utc_SYSTEMTIME 340 | utc_DateToSystemTime.utc_wYear = VBA.Year(utc_Value) 341 | utc_DateToSystemTime.utc_wMonth = VBA.Month(utc_Value) 342 | utc_DateToSystemTime.utc_wDay = VBA.Day(utc_Value) 343 | utc_DateToSystemTime.utc_wHour = VBA.Hour(utc_Value) 344 | utc_DateToSystemTime.utc_wMinute = VBA.Minute(utc_Value) 345 | utc_DateToSystemTime.utc_wSecond = VBA.Second(utc_Value) 346 | utc_DateToSystemTime.utc_wMilliseconds = 0 347 | End Function 348 | 349 | Private Function utc_SystemTimeToDate(utc_Value As utc_SYSTEMTIME) As Date 350 | utc_SystemTimeToDate = DateSerial(utc_Value.utc_wYear, utc_Value.utc_wMonth, utc_Value.utc_wDay) + _ 351 | TimeSerial(utc_Value.utc_wHour, utc_Value.utc_wMinute, utc_Value.utc_wSecond) 352 | End Function 353 | 354 | #End If 355 | -------------------------------------------------------------------------------- /specs/Specs.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "Specs" 2 | Private pOffsetMinutes As Long 3 | Private pOffsetLoaded As Boolean 4 | Public Property Get OffSetMinutes() As Long 5 | If Not pOffsetLoaded Then 6 | Dim InputValue As String 7 | InputValue = VBA.InputBox("Enter UTC Offset (in minutes)" & vbNewLine & vbNewLine & _ 8 | "Example:" & vbNewLine & _ 9 | "EST (UTC-5:00) and DST (+1:00)" & vbNewLine & _ 10 | "= UTC-4:00" & vbNewLine & _ 11 | "= -240", "Enter UTC Offset", 0) 12 | 13 | If InputValue <> "" Then: pOffsetMinutes = CLng(InputValue) 14 | 15 | pOffsetLoaded = True 16 | End If 17 | 18 | OffSetMinutes = pOffsetMinutes 19 | End Property 20 | Public Property Let OffSetMinutes(Value As Long) 21 | pOffsetMinutes = Value 22 | pOffsetLoaded = True 23 | End Property 24 | 25 | Public Function Specs() As SpecSuite 26 | Set Specs = New SpecSuite 27 | Specs.Description = "VBA-UTC" 28 | 29 | Dim LocalDate As Date 30 | Dim LocalIso As String 31 | Dim UtcDate As Date 32 | Dim UtcIso As String 33 | Dim TZOffsetHours As Integer 34 | Dim TZOffsetMinutes As Integer 35 | Dim Offset As String 36 | 37 | ' May 6, 2004 7:08:09 PM 38 | LocalDate = 38113.7973263889 39 | LocalIso = "2004-05-06T19:08:09.000Z" 40 | 41 | ' May 6, 2004 11:08:09 PM 42 | UtcDate = LocalDate - OffSetMinutes / 60 / 24 43 | UtcIso = VBA.Format$(UtcDate, "yyyy-mm-ddTHH:mm:ss.000Z") 44 | 45 | TZOffsetHours = Int(-OffSetMinutes / 60) 46 | TZOffsetMinutes = -(OffSetMinutes + (TZOffsetHours * 60)) 47 | 48 | ' ============================================= ' 49 | ' ParseUTC 50 | ' ============================================= ' 51 | With Specs.It("should parse UTC") 52 | .Expect(DateToString(UtcConverter.ParseUtc(UtcDate))).ToEqual DateToString(LocalDate) 53 | End With 54 | 55 | ' ============================================= ' 56 | ' ConvertToUTC 57 | ' ============================================= ' 58 | With Specs.It("should convert to UTC") 59 | .Expect(DateToString(UtcConverter.ConvertToUtc(LocalDate))).ToEqual DateToString(UtcDate) 60 | End With 61 | 62 | ' ============================================= ' 63 | ' ParseISO 64 | ' ============================================= ' 65 | With Specs.It("should parse ISO 8601") 66 | .Expect(DateToString(UtcConverter.ParseIso(UtcIso))).ToEqual "2004-05-06T19:08:09" 67 | End With 68 | 69 | With Specs.It("should parse ISO 8601 with offset") 70 | Offset = VBA.Right$("0" & TZOffsetHours, 2) & ":" & VBA.Right$("0" & (TZOffsetMinutes + 1), 2) & ":02" 71 | .Expect(DateToString(UtcConverter.ParseIso("2004-05-06T19:07:07-" & Offset))).ToEqual "2004-05-06T19:08:09" 72 | End With 73 | 74 | With Specs.It("should parse ISO 8601 with varying time format") 75 | Offset = VBA.Right$("0" & TZOffsetHours, 2) 76 | .Expect(DateToString(UtcConverter.ParseIso("2004-05-06T19-" & Offset))).ToEqual "2004-05-06T19:00:00" 77 | 78 | Offset = VBA.Right$("0" & TZOffsetHours, 2) & ":" & VBA.Right$("0" & (TZOffsetMinutes + 1), 2) 79 | .Expect(DateToString(UtcConverter.ParseIso("2004-05-06T19:07-" & Offset))).ToEqual "2004-05-06T19:08:00" 80 | .Expect(DateToString(UtcConverter.ParseIso("2004-05-06T12Z"))).ToEqual _ 81 | DateToString(DateSerial(2004, 5, 6) + TimeSerial(12, 0, 0) + OffSetMinutes / 60 / 24) 82 | .Expect(DateToString(UtcConverter.ParseIso("2004-05-06T12:08Z"))).ToEqual _ 83 | DateToString(DateSerial(2004, 5, 6) + TimeSerial(12, 8, 0) + OffSetMinutes / 60 / 24) 84 | End With 85 | 86 | ' ============================================= ' 87 | ' ConvertToISO 88 | ' ============================================= ' 89 | With Specs.It("should convert to ISO 8601") 90 | .Expect(UtcConverter.ConvertToIso(LocalDate)).ToEqual UtcIso 91 | End With 92 | 93 | ' ============================================= ' 94 | ' Errors 95 | ' ============================================= ' 96 | On Error Resume Next 97 | 98 | 99 | InlineRunner.RunSuite Specs 100 | End Function 101 | 102 | Public Sub RunSpecs() 103 | DisplayRunner.IdCol = 1 104 | DisplayRunner.DescCol = 1 105 | DisplayRunner.ResultCol = 2 106 | DisplayRunner.OutputStartRow = 4 107 | 108 | DisplayRunner.RunSuite Specs 109 | End Sub 110 | 111 | Private Function DateToString(Value As Date) As String 112 | DateToString = VBA.Format$(Value, "yyyy-mm-ddTHH:mm:ss") 113 | End Function 114 | -------------------------------------------------------------------------------- /specs/VBA-UTC - Specs.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VBA-tools/VBA-UTC/122928ec2062e13a73333d3d00f3a8cc73f04304/specs/VBA-UTC - Specs.xlsm --------------------------------------------------------------------------------