├── Demo_ChatGPT.xlsm ├── JsonConverter.bas ├── LICENSE.txt ├── README.md ├── assets ├── ai_companion.png ├── exceed_current_quota.png └── invalid_api_key.png └── mChatGPT.bas /Demo_ChatGPT.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Sven-Bo/Integrate-GPT4-in-Excel-using-VBA/1e98923d23328e65bc9ced90d9d2e472a0fa840e/Demo_ChatGPT.xlsm -------------------------------------------------------------------------------- /JsonConverter.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "JsonConverter" 2 | '' 3 | ' VBA-JSON v2.3.1 4 | ' (c) Tim Hall - https://github.com/VBA-tools/VBA-JSON 5 | ' 6 | ' JSON Converter for VBA 7 | ' 8 | ' Errors: 9 | ' 10001 - JSON parse error 10 | ' 11 | ' @class JsonConverter 12 | ' @author tim.hall.engr@gmail.com 13 | ' @license MIT (http://www.opensource.org/licenses/mit-license.php) 14 | '' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' 15 | ' 16 | ' Based originally on vba-json (with extensive changes) 17 | ' BSD license included below 18 | ' 19 | ' JSONLib, http://code.google.com/p/vba-json/ 20 | ' 21 | ' Copyright (c) 2013, Ryo Yokoyama 22 | ' All rights reserved. 23 | ' 24 | ' Redistribution and use in source and binary forms, with or without 25 | ' modification, are permitted provided that the following conditions are met: 26 | ' * Redistributions of source code must retain the above copyright 27 | ' notice, this list of conditions and the following disclaimer. 28 | ' * Redistributions in binary form must reproduce the above copyright 29 | ' notice, this list of conditions and the following disclaimer in the 30 | ' documentation and/or other materials provided with the distribution. 31 | ' * Neither the name of the nor the 32 | ' names of its contributors may be used to endorse or promote products 33 | ' derived from this software without specific prior written permission. 34 | ' 35 | ' THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 36 | ' ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 37 | ' WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 38 | ' DISCLAIMED. IN NO EVENT SHALL BE LIABLE FOR ANY 39 | ' DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 40 | ' (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 41 | ' LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 42 | ' ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 43 | ' (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 44 | ' SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 45 | ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' 46 | Option Explicit 47 | 48 | ' === VBA-UTC Headers 49 | #If Mac Then 50 | 51 | #If VBA7 Then 52 | 53 | ' 64-bit Mac (2016) 54 | Private Declare PtrSafe Function utc_popen Lib "/usr/lib/libc.dylib" Alias "popen" _ 55 | (ByVal utc_Command As String, ByVal utc_Mode As String) As LongPtr 56 | Private Declare PtrSafe Function utc_pclose Lib "/usr/lib/libc.dylib" Alias "pclose" _ 57 | (ByVal utc_File As LongPtr) As LongPtr 58 | Private Declare PtrSafe Function utc_fread Lib "/usr/lib/libc.dylib" Alias "fread" _ 59 | (ByVal utc_Buffer As String, ByVal utc_Size As LongPtr, ByVal utc_Number As LongPtr, ByVal utc_File As LongPtr) As LongPtr 60 | Private Declare PtrSafe Function utc_feof Lib "/usr/lib/libc.dylib" Alias "feof" _ 61 | (ByVal utc_File As LongPtr) As LongPtr 62 | 63 | #Else 64 | 65 | ' 32-bit Mac 66 | Private Declare Function utc_popen Lib "libc.dylib" Alias "popen" _ 67 | (ByVal utc_Command As String, ByVal utc_Mode As String) As Long 68 | Private Declare Function utc_pclose Lib "libc.dylib" Alias "pclose" _ 69 | (ByVal utc_File As Long) As Long 70 | Private Declare Function utc_fread Lib "libc.dylib" Alias "fread" _ 71 | (ByVal utc_Buffer As String, ByVal utc_Size As Long, ByVal utc_Number As Long, ByVal utc_File As Long) As Long 72 | Private Declare Function utc_feof Lib "libc.dylib" Alias "feof" _ 73 | (ByVal utc_File As Long) As Long 74 | 75 | #End If 76 | 77 | #ElseIf VBA7 Then 78 | 79 | ' http://msdn.microsoft.com/en-us/library/windows/desktop/ms724421.aspx 80 | ' http://msdn.microsoft.com/en-us/library/windows/desktop/ms724949.aspx 81 | ' http://msdn.microsoft.com/en-us/library/windows/desktop/ms725485.aspx 82 | Private Declare PtrSafe Function utc_GetTimeZoneInformation Lib "kernel32" Alias "GetTimeZoneInformation" _ 83 | (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION) As Long 84 | Private Declare PtrSafe Function utc_SystemTimeToTzSpecificLocalTime Lib "kernel32" Alias "SystemTimeToTzSpecificLocalTime" _ 85 | (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION, utc_lpUniversalTime As utc_SYSTEMTIME, utc_lpLocalTime As utc_SYSTEMTIME) As Long 86 | Private Declare PtrSafe Function utc_TzSpecificLocalTimeToSystemTime Lib "kernel32" Alias "TzSpecificLocalTimeToSystemTime" _ 87 | (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION, utc_lpLocalTime As utc_SYSTEMTIME, utc_lpUniversalTime As utc_SYSTEMTIME) As Long 88 | 89 | #Else 90 | 91 | Private Declare Function utc_GetTimeZoneInformation Lib "kernel32" Alias "GetTimeZoneInformation" _ 92 | (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION) As Long 93 | Private Declare Function utc_SystemTimeToTzSpecificLocalTime Lib "kernel32" Alias "SystemTimeToTzSpecificLocalTime" _ 94 | (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION, utc_lpUniversalTime As utc_SYSTEMTIME, utc_lpLocalTime As utc_SYSTEMTIME) As Long 95 | Private Declare Function utc_TzSpecificLocalTimeToSystemTime Lib "kernel32" Alias "TzSpecificLocalTimeToSystemTime" _ 96 | (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION, utc_lpLocalTime As utc_SYSTEMTIME, utc_lpUniversalTime As utc_SYSTEMTIME) As Long 97 | 98 | #End If 99 | 100 | #If Mac Then 101 | 102 | #If VBA7 Then 103 | Private Type utc_ShellResult 104 | utc_Output As String 105 | utc_ExitCode As LongPtr 106 | End Type 107 | 108 | #Else 109 | 110 | Private Type utc_ShellResult 111 | utc_Output As String 112 | utc_ExitCode As Long 113 | End Type 114 | 115 | #End If 116 | 117 | #Else 118 | 119 | Private Type utc_SYSTEMTIME 120 | utc_wYear As Integer 121 | utc_wMonth As Integer 122 | utc_wDayOfWeek As Integer 123 | utc_wDay As Integer 124 | utc_wHour As Integer 125 | utc_wMinute As Integer 126 | utc_wSecond As Integer 127 | utc_wMilliseconds As Integer 128 | End Type 129 | 130 | Private Type utc_TIME_ZONE_INFORMATION 131 | utc_Bias As Long 132 | utc_StandardName(0 To 31) As Integer 133 | utc_StandardDate As utc_SYSTEMTIME 134 | utc_StandardBias As Long 135 | utc_DaylightName(0 To 31) As Integer 136 | utc_DaylightDate As utc_SYSTEMTIME 137 | utc_DaylightBias As Long 138 | End Type 139 | 140 | #End If 141 | ' === End VBA-UTC 142 | 143 | Private Type json_Options 144 | ' VBA only stores 15 significant digits, so any numbers larger than that are truncated 145 | ' This can lead to issues when BIGINT's are used (e.g. for Ids or Credit Cards), as they will be invalid above 15 digits 146 | ' See: http://support.microsoft.com/kb/269370 147 | ' 148 | ' By default, VBA-JSON will use String for numbers longer than 15 characters that contain only digits 149 | ' to override set `JsonConverter.JsonOptions.UseDoubleForLargeNumbers = True` 150 | UseDoubleForLargeNumbers As Boolean 151 | 152 | ' The JSON standard requires object keys to be quoted (" or '), use this option to allow unquoted keys 153 | AllowUnquotedKeys As Boolean 154 | 155 | ' The solidus (/) is not required to be escaped, use this option to escape them as \/ in ConvertToJson 156 | EscapeSolidus As Boolean 157 | End Type 158 | Public JsonOptions As json_Options 159 | 160 | ' ============================================= ' 161 | ' Public Methods 162 | ' ============================================= ' 163 | 164 | '' 165 | ' Convert JSON string to object (Dictionary/Collection) 166 | ' 167 | ' @method ParseJson 168 | ' @param {String} json_String 169 | ' @return {Object} (Dictionary or Collection) 170 | ' @throws 10001 - JSON parse error 171 | '' 172 | Public Function ParseJson(ByVal JsonString As String) As Object 173 | Dim json_Index As Long 174 | json_Index = 1 175 | 176 | ' Remove vbCr, vbLf, and vbTab from json_String 177 | JsonString = VBA.Replace(VBA.Replace(VBA.Replace(JsonString, VBA.vbCr, ""), VBA.vbLf, ""), VBA.vbTab, "") 178 | 179 | json_SkipSpaces JsonString, json_Index 180 | Select Case VBA.Mid$(JsonString, json_Index, 1) 181 | Case "{" 182 | Set ParseJson = json_ParseObject(JsonString, json_Index) 183 | Case "[" 184 | Set ParseJson = json_ParseArray(JsonString, json_Index) 185 | Case Else 186 | ' Error: Invalid JSON string 187 | Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(JsonString, json_Index, "Expecting '{' or '['") 188 | End Select 189 | End Function 190 | 191 | '' 192 | ' Convert object (Dictionary/Collection/Array) to JSON 193 | ' 194 | ' @method ConvertToJson 195 | ' @param {Variant} JsonValue (Dictionary, Collection, or Array) 196 | ' @param {Integer|String} Whitespace "Pretty" print json with given number of spaces per indentation (Integer) or given string 197 | ' @return {String} 198 | '' 199 | Public Function ConvertToJson(ByVal JsonValue As Variant, Optional ByVal Whitespace As Variant, Optional ByVal json_CurrentIndentation As Long = 0) As String 200 | Dim json_Buffer As String 201 | Dim json_BufferPosition As Long 202 | Dim json_BufferLength As Long 203 | Dim json_Index As Long 204 | Dim json_LBound As Long 205 | Dim json_UBound As Long 206 | Dim json_IsFirstItem As Boolean 207 | Dim json_Index2D As Long 208 | Dim json_LBound2D As Long 209 | Dim json_UBound2D As Long 210 | Dim json_IsFirstItem2D As Boolean 211 | Dim json_Key As Variant 212 | Dim json_Value As Variant 213 | Dim json_DateStr As String 214 | Dim json_Converted As String 215 | Dim json_SkipItem As Boolean 216 | Dim json_PrettyPrint As Boolean 217 | Dim json_Indentation As String 218 | Dim json_InnerIndentation As String 219 | 220 | json_LBound = -1 221 | json_UBound = -1 222 | json_IsFirstItem = True 223 | json_LBound2D = -1 224 | json_UBound2D = -1 225 | json_IsFirstItem2D = True 226 | json_PrettyPrint = Not IsMissing(Whitespace) 227 | 228 | Select Case VBA.VarType(JsonValue) 229 | Case VBA.vbNull 230 | ConvertToJson = "null" 231 | Case VBA.vbDate 232 | ' Date 233 | json_DateStr = ConvertToIso(VBA.CDate(JsonValue)) 234 | 235 | ConvertToJson = """" & json_DateStr & """" 236 | Case VBA.vbString 237 | ' String (or large number encoded as string) 238 | If Not JsonOptions.UseDoubleForLargeNumbers And json_StringIsLargeNumber(JsonValue) Then 239 | ConvertToJson = JsonValue 240 | Else 241 | ConvertToJson = """" & json_Encode(JsonValue) & """" 242 | End If 243 | Case VBA.vbBoolean 244 | If JsonValue Then 245 | ConvertToJson = "true" 246 | Else 247 | ConvertToJson = "false" 248 | End If 249 | Case VBA.vbArray To VBA.vbArray + VBA.vbByte 250 | If json_PrettyPrint Then 251 | If VBA.VarType(Whitespace) = VBA.vbString Then 252 | json_Indentation = VBA.String$(json_CurrentIndentation + 1, Whitespace) 253 | json_InnerIndentation = VBA.String$(json_CurrentIndentation + 2, Whitespace) 254 | Else 255 | json_Indentation = VBA.Space$((json_CurrentIndentation + 1) * Whitespace) 256 | json_InnerIndentation = VBA.Space$((json_CurrentIndentation + 2) * Whitespace) 257 | End If 258 | End If 259 | 260 | ' Array 261 | json_BufferAppend json_Buffer, "[", json_BufferPosition, json_BufferLength 262 | 263 | On Error Resume Next 264 | 265 | json_LBound = LBound(JsonValue, 1) 266 | json_UBound = UBound(JsonValue, 1) 267 | json_LBound2D = LBound(JsonValue, 2) 268 | json_UBound2D = UBound(JsonValue, 2) 269 | 270 | If json_LBound >= 0 And json_UBound >= 0 Then 271 | For json_Index = json_LBound To json_UBound 272 | If json_IsFirstItem Then 273 | json_IsFirstItem = False 274 | Else 275 | ' Append comma to previous line 276 | json_BufferAppend json_Buffer, ",", json_BufferPosition, json_BufferLength 277 | End If 278 | 279 | If json_LBound2D >= 0 And json_UBound2D >= 0 Then 280 | ' 2D Array 281 | If json_PrettyPrint Then 282 | json_BufferAppend json_Buffer, vbNewLine, json_BufferPosition, json_BufferLength 283 | End If 284 | json_BufferAppend json_Buffer, json_Indentation & "[", json_BufferPosition, json_BufferLength 285 | 286 | For json_Index2D = json_LBound2D To json_UBound2D 287 | If json_IsFirstItem2D Then 288 | json_IsFirstItem2D = False 289 | Else 290 | json_BufferAppend json_Buffer, ",", json_BufferPosition, json_BufferLength 291 | End If 292 | 293 | json_Converted = ConvertToJson(JsonValue(json_Index, json_Index2D), Whitespace, json_CurrentIndentation + 2) 294 | 295 | ' For Arrays/Collections, undefined (Empty/Nothing) is treated as null 296 | If json_Converted = "" Then 297 | ' (nest to only check if converted = "") 298 | If json_IsUndefined(JsonValue(json_Index, json_Index2D)) Then 299 | json_Converted = "null" 300 | End If 301 | End If 302 | 303 | If json_PrettyPrint Then 304 | json_Converted = vbNewLine & json_InnerIndentation & json_Converted 305 | End If 306 | 307 | json_BufferAppend json_Buffer, json_Converted, json_BufferPosition, json_BufferLength 308 | Next json_Index2D 309 | 310 | If json_PrettyPrint Then 311 | json_BufferAppend json_Buffer, vbNewLine, json_BufferPosition, json_BufferLength 312 | End If 313 | 314 | json_BufferAppend json_Buffer, json_Indentation & "]", json_BufferPosition, json_BufferLength 315 | json_IsFirstItem2D = True 316 | Else 317 | ' 1D Array 318 | json_Converted = ConvertToJson(JsonValue(json_Index), Whitespace, json_CurrentIndentation + 1) 319 | 320 | ' For Arrays/Collections, undefined (Empty/Nothing) is treated as null 321 | If json_Converted = "" Then 322 | ' (nest to only check if converted = "") 323 | If json_IsUndefined(JsonValue(json_Index)) Then 324 | json_Converted = "null" 325 | End If 326 | End If 327 | 328 | If json_PrettyPrint Then 329 | json_Converted = vbNewLine & json_Indentation & json_Converted 330 | End If 331 | 332 | json_BufferAppend json_Buffer, json_Converted, json_BufferPosition, json_BufferLength 333 | End If 334 | Next json_Index 335 | End If 336 | 337 | On Error GoTo 0 338 | 339 | If json_PrettyPrint Then 340 | json_BufferAppend json_Buffer, vbNewLine, json_BufferPosition, json_BufferLength 341 | 342 | If VBA.VarType(Whitespace) = VBA.vbString Then 343 | json_Indentation = VBA.String$(json_CurrentIndentation, Whitespace) 344 | Else 345 | json_Indentation = VBA.Space$(json_CurrentIndentation * Whitespace) 346 | End If 347 | End If 348 | 349 | json_BufferAppend json_Buffer, json_Indentation & "]", json_BufferPosition, json_BufferLength 350 | 351 | ConvertToJson = json_BufferToString(json_Buffer, json_BufferPosition) 352 | 353 | ' Dictionary or Collection 354 | Case VBA.vbObject 355 | If json_PrettyPrint Then 356 | If VBA.VarType(Whitespace) = VBA.vbString Then 357 | json_Indentation = VBA.String$(json_CurrentIndentation + 1, Whitespace) 358 | Else 359 | json_Indentation = VBA.Space$((json_CurrentIndentation + 1) * Whitespace) 360 | End If 361 | End If 362 | 363 | ' Dictionary 364 | If VBA.TypeName(JsonValue) = "Dictionary" Then 365 | json_BufferAppend json_Buffer, "{", json_BufferPosition, json_BufferLength 366 | For Each json_Key In JsonValue.Keys 367 | ' For Objects, undefined (Empty/Nothing) is not added to object 368 | json_Converted = ConvertToJson(JsonValue(json_Key), Whitespace, json_CurrentIndentation + 1) 369 | If json_Converted = "" Then 370 | json_SkipItem = json_IsUndefined(JsonValue(json_Key)) 371 | Else 372 | json_SkipItem = False 373 | End If 374 | 375 | If Not json_SkipItem Then 376 | If json_IsFirstItem Then 377 | json_IsFirstItem = False 378 | Else 379 | json_BufferAppend json_Buffer, ",", json_BufferPosition, json_BufferLength 380 | End If 381 | 382 | If json_PrettyPrint Then 383 | json_Converted = vbNewLine & json_Indentation & """" & json_Key & """: " & json_Converted 384 | Else 385 | json_Converted = """" & json_Key & """:" & json_Converted 386 | End If 387 | 388 | json_BufferAppend json_Buffer, json_Converted, json_BufferPosition, json_BufferLength 389 | End If 390 | Next json_Key 391 | 392 | If json_PrettyPrint Then 393 | json_BufferAppend json_Buffer, vbNewLine, json_BufferPosition, json_BufferLength 394 | 395 | If VBA.VarType(Whitespace) = VBA.vbString Then 396 | json_Indentation = VBA.String$(json_CurrentIndentation, Whitespace) 397 | Else 398 | json_Indentation = VBA.Space$(json_CurrentIndentation * Whitespace) 399 | End If 400 | End If 401 | 402 | json_BufferAppend json_Buffer, json_Indentation & "}", json_BufferPosition, json_BufferLength 403 | 404 | ' Collection 405 | ElseIf VBA.TypeName(JsonValue) = "Collection" Then 406 | json_BufferAppend json_Buffer, "[", json_BufferPosition, json_BufferLength 407 | For Each json_Value In JsonValue 408 | If json_IsFirstItem Then 409 | json_IsFirstItem = False 410 | Else 411 | json_BufferAppend json_Buffer, ",", json_BufferPosition, json_BufferLength 412 | End If 413 | 414 | json_Converted = ConvertToJson(json_Value, Whitespace, json_CurrentIndentation + 1) 415 | 416 | ' For Arrays/Collections, undefined (Empty/Nothing) is treated as null 417 | If json_Converted = "" Then 418 | ' (nest to only check if converted = "") 419 | If json_IsUndefined(json_Value) Then 420 | json_Converted = "null" 421 | End If 422 | End If 423 | 424 | If json_PrettyPrint Then 425 | json_Converted = vbNewLine & json_Indentation & json_Converted 426 | End If 427 | 428 | json_BufferAppend json_Buffer, json_Converted, json_BufferPosition, json_BufferLength 429 | Next json_Value 430 | 431 | If json_PrettyPrint Then 432 | json_BufferAppend json_Buffer, vbNewLine, json_BufferPosition, json_BufferLength 433 | 434 | If VBA.VarType(Whitespace) = VBA.vbString Then 435 | json_Indentation = VBA.String$(json_CurrentIndentation, Whitespace) 436 | Else 437 | json_Indentation = VBA.Space$(json_CurrentIndentation * Whitespace) 438 | End If 439 | End If 440 | 441 | json_BufferAppend json_Buffer, json_Indentation & "]", json_BufferPosition, json_BufferLength 442 | End If 443 | 444 | ConvertToJson = json_BufferToString(json_Buffer, json_BufferPosition) 445 | Case VBA.vbInteger, VBA.vbLong, VBA.vbSingle, VBA.vbDouble, VBA.vbCurrency, VBA.vbDecimal 446 | ' Number (use decimals for numbers) 447 | ConvertToJson = VBA.Replace(JsonValue, ",", ".") 448 | Case Else 449 | ' vbEmpty, vbError, vbDataObject, vbByte, vbUserDefinedType 450 | ' Use VBA's built-in to-string 451 | On Error Resume Next 452 | ConvertToJson = JsonValue 453 | On Error GoTo 0 454 | End Select 455 | End Function 456 | 457 | ' ============================================= ' 458 | ' Private Functions 459 | ' ============================================= ' 460 | 461 | Private Function json_ParseObject(json_String As String, ByRef json_Index As Long) As Dictionary 462 | Dim json_Key As String 463 | Dim json_NextChar As String 464 | 465 | Set json_ParseObject = New Dictionary 466 | json_SkipSpaces json_String, json_Index 467 | If VBA.Mid$(json_String, json_Index, 1) <> "{" Then 468 | Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(json_String, json_Index, "Expecting '{'") 469 | Else 470 | json_Index = json_Index + 1 471 | 472 | Do 473 | json_SkipSpaces json_String, json_Index 474 | If VBA.Mid$(json_String, json_Index, 1) = "}" Then 475 | json_Index = json_Index + 1 476 | Exit Function 477 | ElseIf VBA.Mid$(json_String, json_Index, 1) = "," Then 478 | json_Index = json_Index + 1 479 | json_SkipSpaces json_String, json_Index 480 | End If 481 | 482 | json_Key = json_ParseKey(json_String, json_Index) 483 | json_NextChar = json_Peek(json_String, json_Index) 484 | If json_NextChar = "[" Or json_NextChar = "{" Then 485 | Set json_ParseObject.Item(json_Key) = json_ParseValue(json_String, json_Index) 486 | Else 487 | json_ParseObject.Item(json_Key) = json_ParseValue(json_String, json_Index) 488 | End If 489 | Loop 490 | End If 491 | End Function 492 | 493 | Private Function json_ParseArray(json_String As String, ByRef json_Index As Long) As Collection 494 | Set json_ParseArray = New Collection 495 | 496 | json_SkipSpaces json_String, json_Index 497 | If VBA.Mid$(json_String, json_Index, 1) <> "[" Then 498 | Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(json_String, json_Index, "Expecting '['") 499 | Else 500 | json_Index = json_Index + 1 501 | 502 | Do 503 | json_SkipSpaces json_String, json_Index 504 | If VBA.Mid$(json_String, json_Index, 1) = "]" Then 505 | json_Index = json_Index + 1 506 | Exit Function 507 | ElseIf VBA.Mid$(json_String, json_Index, 1) = "," Then 508 | json_Index = json_Index + 1 509 | json_SkipSpaces json_String, json_Index 510 | End If 511 | 512 | json_ParseArray.Add json_ParseValue(json_String, json_Index) 513 | Loop 514 | End If 515 | End Function 516 | 517 | Private Function json_ParseValue(json_String As String, ByRef json_Index As Long) As Variant 518 | json_SkipSpaces json_String, json_Index 519 | Select Case VBA.Mid$(json_String, json_Index, 1) 520 | Case "{" 521 | Set json_ParseValue = json_ParseObject(json_String, json_Index) 522 | Case "[" 523 | Set json_ParseValue = json_ParseArray(json_String, json_Index) 524 | Case """", "'" 525 | json_ParseValue = json_ParseString(json_String, json_Index) 526 | Case Else 527 | If VBA.Mid$(json_String, json_Index, 4) = "true" Then 528 | json_ParseValue = True 529 | json_Index = json_Index + 4 530 | ElseIf VBA.Mid$(json_String, json_Index, 5) = "false" Then 531 | json_ParseValue = False 532 | json_Index = json_Index + 5 533 | ElseIf VBA.Mid$(json_String, json_Index, 4) = "null" Then 534 | json_ParseValue = Null 535 | json_Index = json_Index + 4 536 | ElseIf VBA.InStr("+-0123456789", VBA.Mid$(json_String, json_Index, 1)) Then 537 | json_ParseValue = json_ParseNumber(json_String, json_Index) 538 | Else 539 | Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(json_String, json_Index, "Expecting 'STRING', 'NUMBER', null, true, false, '{', or '['") 540 | End If 541 | End Select 542 | End Function 543 | 544 | Private Function json_ParseString(json_String As String, ByRef json_Index As Long) As String 545 | Dim json_Quote As String 546 | Dim json_Char As String 547 | Dim json_Code As String 548 | Dim json_Buffer As String 549 | Dim json_BufferPosition As Long 550 | Dim json_BufferLength As Long 551 | 552 | json_SkipSpaces json_String, json_Index 553 | 554 | ' Store opening quote to look for matching closing quote 555 | json_Quote = VBA.Mid$(json_String, json_Index, 1) 556 | json_Index = json_Index + 1 557 | 558 | Do While json_Index > 0 And json_Index <= Len(json_String) 559 | json_Char = VBA.Mid$(json_String, json_Index, 1) 560 | 561 | Select Case json_Char 562 | Case "\" 563 | ' Escaped string, \\, or \/ 564 | json_Index = json_Index + 1 565 | json_Char = VBA.Mid$(json_String, json_Index, 1) 566 | 567 | Select Case json_Char 568 | Case """", "\", "/", "'" 569 | json_BufferAppend json_Buffer, json_Char, json_BufferPosition, json_BufferLength 570 | json_Index = json_Index + 1 571 | Case "b" 572 | json_BufferAppend json_Buffer, vbBack, json_BufferPosition, json_BufferLength 573 | json_Index = json_Index + 1 574 | Case "f" 575 | json_BufferAppend json_Buffer, vbFormFeed, json_BufferPosition, json_BufferLength 576 | json_Index = json_Index + 1 577 | Case "n" 578 | json_BufferAppend json_Buffer, vbCrLf, json_BufferPosition, json_BufferLength 579 | json_Index = json_Index + 1 580 | Case "r" 581 | json_BufferAppend json_Buffer, vbCr, json_BufferPosition, json_BufferLength 582 | json_Index = json_Index + 1 583 | Case "t" 584 | json_BufferAppend json_Buffer, vbTab, json_BufferPosition, json_BufferLength 585 | json_Index = json_Index + 1 586 | Case "u" 587 | ' Unicode character escape (e.g. \u00a9 = Copyright) 588 | json_Index = json_Index + 1 589 | json_Code = VBA.Mid$(json_String, json_Index, 4) 590 | json_BufferAppend json_Buffer, VBA.ChrW(VBA.Val("&h" + json_Code)), json_BufferPosition, json_BufferLength 591 | json_Index = json_Index + 4 592 | End Select 593 | Case json_Quote 594 | json_ParseString = json_BufferToString(json_Buffer, json_BufferPosition) 595 | json_Index = json_Index + 1 596 | Exit Function 597 | Case Else 598 | json_BufferAppend json_Buffer, json_Char, json_BufferPosition, json_BufferLength 599 | json_Index = json_Index + 1 600 | End Select 601 | Loop 602 | End Function 603 | 604 | Private Function json_ParseNumber(json_String As String, ByRef json_Index As Long) As Variant 605 | Dim json_Char As String 606 | Dim json_Value As String 607 | Dim json_IsLargeNumber As Boolean 608 | 609 | json_SkipSpaces json_String, json_Index 610 | 611 | Do While json_Index > 0 And json_Index <= Len(json_String) 612 | json_Char = VBA.Mid$(json_String, json_Index, 1) 613 | 614 | If VBA.InStr("+-0123456789.eE", json_Char) Then 615 | ' Unlikely to have massive number, so use simple append rather than buffer here 616 | json_Value = json_Value & json_Char 617 | json_Index = json_Index + 1 618 | Else 619 | ' Excel only stores 15 significant digits, so any numbers larger than that are truncated 620 | ' This can lead to issues when BIGINT's are used (e.g. for Ids or Credit Cards), as they will be invalid above 15 digits 621 | ' See: http://support.microsoft.com/kb/269370 622 | ' 623 | ' Fix: Parse -> String, Convert -> String longer than 15/16 characters containing only numbers and decimal points -> Number 624 | ' (decimal doesn't factor into significant digit count, so if present check for 15 digits + decimal = 16) 625 | json_IsLargeNumber = IIf(InStr(json_Value, "."), Len(json_Value) >= 17, Len(json_Value) >= 16) 626 | If Not JsonOptions.UseDoubleForLargeNumbers And json_IsLargeNumber Then 627 | json_ParseNumber = json_Value 628 | Else 629 | ' VBA.Val does not use regional settings, so guard for comma is not needed 630 | json_ParseNumber = VBA.Val(json_Value) 631 | End If 632 | Exit Function 633 | End If 634 | Loop 635 | End Function 636 | 637 | Private Function json_ParseKey(json_String As String, ByRef json_Index As Long) As String 638 | ' Parse key with single or double quotes 639 | If VBA.Mid$(json_String, json_Index, 1) = """" Or VBA.Mid$(json_String, json_Index, 1) = "'" Then 640 | json_ParseKey = json_ParseString(json_String, json_Index) 641 | ElseIf JsonOptions.AllowUnquotedKeys Then 642 | Dim json_Char As String 643 | Do While json_Index > 0 And json_Index <= Len(json_String) 644 | json_Char = VBA.Mid$(json_String, json_Index, 1) 645 | If (json_Char <> " ") And (json_Char <> ":") Then 646 | json_ParseKey = json_ParseKey & json_Char 647 | json_Index = json_Index + 1 648 | Else 649 | Exit Do 650 | End If 651 | Loop 652 | Else 653 | Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(json_String, json_Index, "Expecting '""' or '''") 654 | End If 655 | 656 | ' Check for colon and skip if present or throw if not present 657 | json_SkipSpaces json_String, json_Index 658 | If VBA.Mid$(json_String, json_Index, 1) <> ":" Then 659 | Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(json_String, json_Index, "Expecting ':'") 660 | Else 661 | json_Index = json_Index + 1 662 | End If 663 | End Function 664 | 665 | Private Function json_IsUndefined(ByVal json_Value As Variant) As Boolean 666 | ' Empty / Nothing -> undefined 667 | Select Case VBA.VarType(json_Value) 668 | Case VBA.vbEmpty 669 | json_IsUndefined = True 670 | Case VBA.vbObject 671 | Select Case VBA.TypeName(json_Value) 672 | Case "Empty", "Nothing" 673 | json_IsUndefined = True 674 | End Select 675 | End Select 676 | End Function 677 | 678 | Private Function json_Encode(ByVal json_Text As Variant) As String 679 | ' Reference: http://www.ietf.org/rfc/rfc4627.txt 680 | ' Escape: ", \, /, backspace, form feed, line feed, carriage return, tab 681 | Dim json_Index As Long 682 | Dim json_Char As String 683 | Dim json_AscCode As Long 684 | Dim json_Buffer As String 685 | Dim json_BufferPosition As Long 686 | Dim json_BufferLength As Long 687 | 688 | For json_Index = 1 To VBA.Len(json_Text) 689 | json_Char = VBA.Mid$(json_Text, json_Index, 1) 690 | json_AscCode = VBA.AscW(json_Char) 691 | 692 | ' When AscW returns a negative number, it returns the twos complement form of that number. 693 | ' To convert the twos complement notation into normal binary notation, add 0xFFF to the return result. 694 | ' https://support.microsoft.com/en-us/kb/272138 695 | If json_AscCode < 0 Then 696 | json_AscCode = json_AscCode + 65536 697 | End If 698 | 699 | ' From spec, ", \, and control characters must be escaped (solidus is optional) 700 | 701 | Select Case json_AscCode 702 | Case 34 703 | ' " -> 34 -> \" 704 | json_Char = "\""" 705 | Case 92 706 | ' \ -> 92 -> \\ 707 | json_Char = "\\" 708 | Case 47 709 | ' / -> 47 -> \/ (optional) 710 | If JsonOptions.EscapeSolidus Then 711 | json_Char = "\/" 712 | End If 713 | Case 8 714 | ' backspace -> 8 -> \b 715 | json_Char = "\b" 716 | Case 12 717 | ' form feed -> 12 -> \f 718 | json_Char = "\f" 719 | Case 10 720 | ' line feed -> 10 -> \n 721 | json_Char = "\n" 722 | Case 13 723 | ' carriage return -> 13 -> \r 724 | json_Char = "\r" 725 | Case 9 726 | ' tab -> 9 -> \t 727 | json_Char = "\t" 728 | Case 0 To 31, 127 To 65535 729 | ' Non-ascii characters -> convert to 4-digit hex 730 | json_Char = "\u" & VBA.Right$("0000" & VBA.Hex$(json_AscCode), 4) 731 | End Select 732 | 733 | json_BufferAppend json_Buffer, json_Char, json_BufferPosition, json_BufferLength 734 | Next json_Index 735 | 736 | json_Encode = json_BufferToString(json_Buffer, json_BufferPosition) 737 | End Function 738 | 739 | Private Function json_Peek(json_String As String, ByVal json_Index As Long, Optional json_NumberOfCharacters As Long = 1) As String 740 | ' "Peek" at the next number of characters without incrementing json_Index (ByVal instead of ByRef) 741 | json_SkipSpaces json_String, json_Index 742 | json_Peek = VBA.Mid$(json_String, json_Index, json_NumberOfCharacters) 743 | End Function 744 | 745 | Private Sub json_SkipSpaces(json_String As String, ByRef json_Index As Long) 746 | ' Increment index to skip over spaces 747 | Do While json_Index > 0 And json_Index <= VBA.Len(json_String) And VBA.Mid$(json_String, json_Index, 1) = " " 748 | json_Index = json_Index + 1 749 | Loop 750 | End Sub 751 | 752 | Private Function json_StringIsLargeNumber(json_String As Variant) As Boolean 753 | ' Check if the given string is considered a "large number" 754 | ' (See json_ParseNumber) 755 | 756 | Dim json_Length As Long 757 | Dim json_CharIndex As Long 758 | json_Length = VBA.Len(json_String) 759 | 760 | ' Length with be at least 16 characters and assume will be less than 100 characters 761 | If json_Length >= 16 And json_Length <= 100 Then 762 | Dim json_CharCode As String 763 | 764 | json_StringIsLargeNumber = True 765 | 766 | For json_CharIndex = 1 To json_Length 767 | json_CharCode = VBA.Asc(VBA.Mid$(json_String, json_CharIndex, 1)) 768 | Select Case json_CharCode 769 | ' Look for .|0-9|E|e 770 | Case 46, 48 To 57, 69, 101 771 | ' Continue through characters 772 | Case Else 773 | json_StringIsLargeNumber = False 774 | Exit Function 775 | End Select 776 | Next json_CharIndex 777 | End If 778 | End Function 779 | 780 | Private Function json_ParseErrorMessage(json_String As String, ByRef json_Index As Long, ErrorMessage As String) 781 | ' Provide detailed parse error message, including details of where and what occurred 782 | ' 783 | ' Example: 784 | ' Error parsing JSON: 785 | ' {"abcde":True} 786 | ' ^ 787 | ' Expecting 'STRING', 'NUMBER', null, true, false, '{', or '[' 788 | 789 | Dim json_StartIndex As Long 790 | Dim json_StopIndex As Long 791 | 792 | ' Include 10 characters before and after error (if possible) 793 | json_StartIndex = json_Index - 10 794 | json_StopIndex = json_Index + 10 795 | If json_StartIndex <= 0 Then 796 | json_StartIndex = 1 797 | End If 798 | If json_StopIndex > VBA.Len(json_String) Then 799 | json_StopIndex = VBA.Len(json_String) 800 | End If 801 | 802 | json_ParseErrorMessage = "Error parsing JSON:" & VBA.vbNewLine & _ 803 | VBA.Mid$(json_String, json_StartIndex, json_StopIndex - json_StartIndex + 1) & VBA.vbNewLine & _ 804 | VBA.Space$(json_Index - json_StartIndex) & "^" & VBA.vbNewLine & _ 805 | ErrorMessage 806 | End Function 807 | 808 | Private Sub json_BufferAppend(ByRef json_Buffer As String, _ 809 | ByRef json_Append As Variant, _ 810 | ByRef json_BufferPosition As Long, _ 811 | ByRef json_BufferLength As Long) 812 | ' VBA can be slow to append strings due to allocating a new string for each append 813 | ' Instead of using the traditional append, allocate a large empty string and then copy string at append position 814 | ' 815 | ' Example: 816 | ' Buffer: "abc " 817 | ' Append: "def" 818 | ' Buffer Position: 3 819 | ' Buffer Length: 5 820 | ' 821 | ' Buffer position + Append length > Buffer length -> Append chunk of blank space to buffer 822 | ' Buffer: "abc " 823 | ' Buffer Length: 10 824 | ' 825 | ' Put "def" into buffer at position 3 (0-based) 826 | ' Buffer: "abcdef " 827 | ' 828 | ' Approach based on cStringBuilder from vbAccelerator 829 | ' http://www.vbaccelerator.com/home/VB/Code/Techniques/RunTime_Debug_Tracing/VB6_Tracer_Utility_zip_cStringBuilder_cls.asp 830 | ' 831 | ' and clsStringAppend from Philip Swannell 832 | ' https://github.com/VBA-tools/VBA-JSON/pull/82 833 | 834 | Dim json_AppendLength As Long 835 | Dim json_LengthPlusPosition As Long 836 | 837 | json_AppendLength = VBA.Len(json_Append) 838 | json_LengthPlusPosition = json_AppendLength + json_BufferPosition 839 | 840 | If json_LengthPlusPosition > json_BufferLength Then 841 | ' Appending would overflow buffer, add chunk 842 | ' (double buffer length or append length, whichever is bigger) 843 | Dim json_AddedLength As Long 844 | json_AddedLength = IIf(json_AppendLength > json_BufferLength, json_AppendLength, json_BufferLength) 845 | 846 | json_Buffer = json_Buffer & VBA.Space$(json_AddedLength) 847 | json_BufferLength = json_BufferLength + json_AddedLength 848 | End If 849 | 850 | ' Note: Namespacing with VBA.Mid$ doesn't work properly here, throwing compile error: 851 | ' Function call on left-hand side of assignment must return Variant or Object 852 | Mid$(json_Buffer, json_BufferPosition + 1, json_AppendLength) = CStr(json_Append) 853 | json_BufferPosition = json_BufferPosition + json_AppendLength 854 | End Sub 855 | 856 | Private Function json_BufferToString(ByRef json_Buffer As String, ByVal json_BufferPosition As Long) As String 857 | If json_BufferPosition > 0 Then 858 | json_BufferToString = VBA.Left$(json_Buffer, json_BufferPosition) 859 | End If 860 | End Function 861 | 862 | '' 863 | ' VBA-UTC v1.0.6 864 | ' (c) Tim Hall - https://github.com/VBA-tools/VBA-UtcConverter 865 | ' 866 | ' UTC/ISO 8601 Converter for VBA 867 | ' 868 | ' Errors: 869 | ' 10011 - UTC parsing error 870 | ' 10012 - UTC conversion error 871 | ' 10013 - ISO 8601 parsing error 872 | ' 10014 - ISO 8601 conversion error 873 | ' 874 | ' @module UtcConverter 875 | ' @author tim.hall.engr@gmail.com 876 | ' @license MIT (http://www.opensource.org/licenses/mit-license.php) 877 | '' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' 878 | 879 | ' (Declarations moved to top) 880 | 881 | ' ============================================= ' 882 | ' Public Methods 883 | ' ============================================= ' 884 | 885 | '' 886 | ' Parse UTC date to local date 887 | ' 888 | ' @method ParseUtc 889 | ' @param {Date} UtcDate 890 | ' @return {Date} Local date 891 | ' @throws 10011 - UTC parsing error 892 | '' 893 | Public Function ParseUtc(utc_UtcDate As Date) As Date 894 | On Error GoTo utc_ErrorHandling 895 | 896 | #If Mac Then 897 | ParseUtc = utc_ConvertDate(utc_UtcDate) 898 | #Else 899 | Dim utc_TimeZoneInfo As utc_TIME_ZONE_INFORMATION 900 | Dim utc_LocalDate As utc_SYSTEMTIME 901 | 902 | utc_GetTimeZoneInformation utc_TimeZoneInfo 903 | utc_SystemTimeToTzSpecificLocalTime utc_TimeZoneInfo, utc_DateToSystemTime(utc_UtcDate), utc_LocalDate 904 | 905 | ParseUtc = utc_SystemTimeToDate(utc_LocalDate) 906 | #End If 907 | 908 | Exit Function 909 | 910 | utc_ErrorHandling: 911 | Err.Raise 10011, "UtcConverter.ParseUtc", "UTC parsing error: " & Err.Number & " - " & Err.Description 912 | End Function 913 | 914 | '' 915 | ' Convert local date to UTC date 916 | ' 917 | ' @method ConvertToUrc 918 | ' @param {Date} utc_LocalDate 919 | ' @return {Date} UTC date 920 | ' @throws 10012 - UTC conversion error 921 | '' 922 | Public Function ConvertToUtc(utc_LocalDate As Date) As Date 923 | On Error GoTo utc_ErrorHandling 924 | 925 | #If Mac Then 926 | ConvertToUtc = utc_ConvertDate(utc_LocalDate, utc_ConvertToUtc:=True) 927 | #Else 928 | Dim utc_TimeZoneInfo As utc_TIME_ZONE_INFORMATION 929 | Dim utc_UtcDate As utc_SYSTEMTIME 930 | 931 | utc_GetTimeZoneInformation utc_TimeZoneInfo 932 | utc_TzSpecificLocalTimeToSystemTime utc_TimeZoneInfo, utc_DateToSystemTime(utc_LocalDate), utc_UtcDate 933 | 934 | ConvertToUtc = utc_SystemTimeToDate(utc_UtcDate) 935 | #End If 936 | 937 | Exit Function 938 | 939 | utc_ErrorHandling: 940 | Err.Raise 10012, "UtcConverter.ConvertToUtc", "UTC conversion error: " & Err.Number & " - " & Err.Description 941 | End Function 942 | 943 | '' 944 | ' Parse ISO 8601 date string to local date 945 | ' 946 | ' @method ParseIso 947 | ' @param {Date} utc_IsoString 948 | ' @return {Date} Local date 949 | ' @throws 10013 - ISO 8601 parsing error 950 | '' 951 | Public Function ParseIso(utc_IsoString As String) As Date 952 | On Error GoTo utc_ErrorHandling 953 | 954 | Dim utc_Parts() As String 955 | Dim utc_DateParts() As String 956 | Dim utc_TimeParts() As String 957 | Dim utc_OffsetIndex As Long 958 | Dim utc_HasOffset As Boolean 959 | Dim utc_NegativeOffset As Boolean 960 | Dim utc_OffsetParts() As String 961 | Dim utc_Offset As Date 962 | 963 | utc_Parts = VBA.Split(utc_IsoString, "T") 964 | utc_DateParts = VBA.Split(utc_Parts(0), "-") 965 | ParseIso = VBA.DateSerial(VBA.CInt(utc_DateParts(0)), VBA.CInt(utc_DateParts(1)), VBA.CInt(utc_DateParts(2))) 966 | 967 | If UBound(utc_Parts) > 0 Then 968 | If VBA.InStr(utc_Parts(1), "Z") Then 969 | utc_TimeParts = VBA.Split(VBA.Replace(utc_Parts(1), "Z", ""), ":") 970 | Else 971 | utc_OffsetIndex = VBA.InStr(1, utc_Parts(1), "+") 972 | If utc_OffsetIndex = 0 Then 973 | utc_NegativeOffset = True 974 | utc_OffsetIndex = VBA.InStr(1, utc_Parts(1), "-") 975 | End If 976 | 977 | If utc_OffsetIndex > 0 Then 978 | utc_HasOffset = True 979 | utc_TimeParts = VBA.Split(VBA.Left$(utc_Parts(1), utc_OffsetIndex - 1), ":") 980 | utc_OffsetParts = VBA.Split(VBA.Right$(utc_Parts(1), Len(utc_Parts(1)) - utc_OffsetIndex), ":") 981 | 982 | Select Case UBound(utc_OffsetParts) 983 | Case 0 984 | utc_Offset = TimeSerial(VBA.CInt(utc_OffsetParts(0)), 0, 0) 985 | Case 1 986 | utc_Offset = TimeSerial(VBA.CInt(utc_OffsetParts(0)), VBA.CInt(utc_OffsetParts(1)), 0) 987 | Case 2 988 | ' VBA.Val does not use regional settings, use for seconds to avoid decimal/comma issues 989 | utc_Offset = TimeSerial(VBA.CInt(utc_OffsetParts(0)), VBA.CInt(utc_OffsetParts(1)), Int(VBA.Val(utc_OffsetParts(2)))) 990 | End Select 991 | 992 | If utc_NegativeOffset Then: utc_Offset = -utc_Offset 993 | Else 994 | utc_TimeParts = VBA.Split(utc_Parts(1), ":") 995 | End If 996 | End If 997 | 998 | Select Case UBound(utc_TimeParts) 999 | Case 0 1000 | ParseIso = ParseIso + VBA.TimeSerial(VBA.CInt(utc_TimeParts(0)), 0, 0) 1001 | Case 1 1002 | ParseIso = ParseIso + VBA.TimeSerial(VBA.CInt(utc_TimeParts(0)), VBA.CInt(utc_TimeParts(1)), 0) 1003 | Case 2 1004 | ' VBA.Val does not use regional settings, use for seconds to avoid decimal/comma issues 1005 | ParseIso = ParseIso + VBA.TimeSerial(VBA.CInt(utc_TimeParts(0)), VBA.CInt(utc_TimeParts(1)), Int(VBA.Val(utc_TimeParts(2)))) 1006 | End Select 1007 | 1008 | ParseIso = ParseUtc(ParseIso) 1009 | 1010 | If utc_HasOffset Then 1011 | ParseIso = ParseIso - utc_Offset 1012 | End If 1013 | End If 1014 | 1015 | Exit Function 1016 | 1017 | utc_ErrorHandling: 1018 | Err.Raise 10013, "UtcConverter.ParseIso", "ISO 8601 parsing error for " & utc_IsoString & ": " & Err.Number & " - " & Err.Description 1019 | End Function 1020 | 1021 | '' 1022 | ' Convert local date to ISO 8601 string 1023 | ' 1024 | ' @method ConvertToIso 1025 | ' @param {Date} utc_LocalDate 1026 | ' @return {Date} ISO 8601 string 1027 | ' @throws 10014 - ISO 8601 conversion error 1028 | '' 1029 | Public Function ConvertToIso(utc_LocalDate As Date) As String 1030 | On Error GoTo utc_ErrorHandling 1031 | 1032 | ConvertToIso = VBA.Format$(ConvertToUtc(utc_LocalDate), "yyyy-mm-ddTHH:mm:ss.000Z") 1033 | 1034 | Exit Function 1035 | 1036 | utc_ErrorHandling: 1037 | Err.Raise 10014, "UtcConverter.ConvertToIso", "ISO 8601 conversion error: " & Err.Number & " - " & Err.Description 1038 | End Function 1039 | 1040 | ' ============================================= ' 1041 | ' Private Functions 1042 | ' ============================================= ' 1043 | 1044 | #If Mac Then 1045 | 1046 | Private Function utc_ConvertDate(utc_Value As Date, Optional utc_ConvertToUtc As Boolean = False) As Date 1047 | Dim utc_ShellCommand As String 1048 | Dim utc_Result As utc_ShellResult 1049 | Dim utc_Parts() As String 1050 | Dim utc_DateParts() As String 1051 | Dim utc_TimeParts() As String 1052 | 1053 | If utc_ConvertToUtc Then 1054 | utc_ShellCommand = "date -ur `date -jf '%Y-%m-%d %H:%M:%S' " & _ 1055 | "'" & VBA.Format$(utc_Value, "yyyy-mm-dd HH:mm:ss") & "' " & _ 1056 | " +'%s'` +'%Y-%m-%d %H:%M:%S'" 1057 | Else 1058 | utc_ShellCommand = "date -jf '%Y-%m-%d %H:%M:%S %z' " & _ 1059 | "'" & VBA.Format$(utc_Value, "yyyy-mm-dd HH:mm:ss") & " +0000' " & _ 1060 | "+'%Y-%m-%d %H:%M:%S'" 1061 | End If 1062 | 1063 | utc_Result = utc_ExecuteInShell(utc_ShellCommand) 1064 | 1065 | If utc_Result.utc_Output = "" Then 1066 | Err.Raise 10015, "UtcConverter.utc_ConvertDate", "'date' command failed" 1067 | Else 1068 | utc_Parts = Split(utc_Result.utc_Output, " ") 1069 | utc_DateParts = Split(utc_Parts(0), "-") 1070 | utc_TimeParts = Split(utc_Parts(1), ":") 1071 | 1072 | utc_ConvertDate = DateSerial(utc_DateParts(0), utc_DateParts(1), utc_DateParts(2)) + _ 1073 | TimeSerial(utc_TimeParts(0), utc_TimeParts(1), utc_TimeParts(2)) 1074 | End If 1075 | End Function 1076 | 1077 | Private Function utc_ExecuteInShell(utc_ShellCommand As String) As utc_ShellResult 1078 | #If VBA7 Then 1079 | Dim utc_File As LongPtr 1080 | Dim utc_Read As LongPtr 1081 | #Else 1082 | Dim utc_File As Long 1083 | Dim utc_Read As Long 1084 | #End If 1085 | 1086 | Dim utc_Chunk As String 1087 | 1088 | On Error GoTo utc_ErrorHandling 1089 | utc_File = utc_popen(utc_ShellCommand, "r") 1090 | 1091 | If utc_File = 0 Then: Exit Function 1092 | 1093 | Do While utc_feof(utc_File) = 0 1094 | utc_Chunk = VBA.Space$(50) 1095 | utc_Read = CLng(utc_fread(utc_Chunk, 1, Len(utc_Chunk) - 1, utc_File)) 1096 | If utc_Read > 0 Then 1097 | utc_Chunk = VBA.Left$(utc_Chunk, CLng(utc_Read)) 1098 | utc_ExecuteInShell.utc_Output = utc_ExecuteInShell.utc_Output & utc_Chunk 1099 | End If 1100 | Loop 1101 | 1102 | utc_ErrorHandling: 1103 | utc_ExecuteInShell.utc_ExitCode = CLng(utc_pclose(utc_File)) 1104 | End Function 1105 | 1106 | #Else 1107 | 1108 | Private Function utc_DateToSystemTime(utc_Value As Date) As utc_SYSTEMTIME 1109 | utc_DateToSystemTime.utc_wYear = VBA.Year(utc_Value) 1110 | utc_DateToSystemTime.utc_wMonth = VBA.Month(utc_Value) 1111 | utc_DateToSystemTime.utc_wDay = VBA.Day(utc_Value) 1112 | utc_DateToSystemTime.utc_wHour = VBA.Hour(utc_Value) 1113 | utc_DateToSystemTime.utc_wMinute = VBA.Minute(utc_Value) 1114 | utc_DateToSystemTime.utc_wSecond = VBA.Second(utc_Value) 1115 | utc_DateToSystemTime.utc_wMilliseconds = 0 1116 | End Function 1117 | 1118 | Private Function utc_SystemTimeToDate(utc_Value As utc_SYSTEMTIME) As Date 1119 | utc_SystemTimeToDate = DateSerial(utc_Value.utc_wYear, utc_Value.utc_wMonth, utc_Value.utc_wDay) + _ 1120 | TimeSerial(utc_Value.utc_wHour, utc_Value.utc_wMinute, utc_Value.utc_wSecond) 1121 | End Function 1122 | 1123 | #End If 1124 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | ChatGPT in Excel 4 | 5 | Copyright (c) 2023 Sven Bosau 6 | 7 | Permission is hereby granted, free of charge, to any person obtaining a copy 8 | of this software and associated documentation files (the "Software"), to deal 9 | in the Software without restriction, including without limitation the rights 10 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 11 | copies of the Software, and to permit persons to whom the Software is 12 | furnished to do so, subject to the following conditions: 13 | 14 | The above copyright notice and this permission notice shall be included in all 15 | copies or substantial portions of the Software. 16 | 17 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 18 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 19 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 20 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 21 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 23 | SOFTWARE. 24 | 25 | ---- 26 | 27 | Code derived from the VBA-JSON project (https://github.com/VBA-tools/VBA-JSON): 28 | 29 | - JsonConverter.bas 30 | 31 | VBA-JSON License: 32 | 33 | Copyright (c) 2016-2019 Tim Hall 34 | 35 | Permission is hereby granted, free of charge, to any person obtaining a copy 36 | of this software and associated documentation files (the "Software"), to deal 37 | in the Software without restriction, including without limitation the rights 38 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 39 | copies of the Software, and to permit persons to whom the Software is 40 | furnished to do so, subject to the following conditions: 41 | 42 | The above copyright notice and this permission notice shall be included in all 43 | copies or substantial portions of the Software. 44 | 45 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 46 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 47 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 48 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 49 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 50 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 51 | SOFTWARE. -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ⚠️ **NOTE**: The provided code and the Excel add-in only works on Windows. ⚠️ 2 |

3 | # GPT-3.5-turbo and GPT-4 in Excel 4 | This repository contains VBA modules that enable integration of the GPT-3.5-turbo and GPT-4 models into Microsoft Excel, as demonstrated in the accompanying [YouTube video](https://youtu.be/3Z96yLlDim0). The provided VBA code allows you to leverage ChatGPT capabilities directly within Excel, aiding in various data processing and text generation tasks. 5 | 6 | ## MyToolBelt Add-in 7 | If you're looking for a more comprehensive solution, consider trying the [MyToolBelt Add-in](https://pythonandvba.com/mytoolbelt). This Excel add-in also integrates ChatGPT into Excel, alongside additional features and improved error handling to enhance the user experience and streamline tasks. 8 | 9 | ![AI Companion Demo](assets/ai_companion.png) 10 | 11 | 12 | ### Video Tutorial 13 | [![YouTube Video](https://img.youtube.com/vi/3Z96yLlDim0/0.jpg)](https://youtu.be/3Z96yLlDim0) 14 | 15 | ## Common Issues and Solutions 16 | 17 | ### I received an error message regarding an OpenAI request failure with a 401 status code, stating that my API key is incorrect. What should I do? 18 | ![Invalid API Key Error](assets/invalid_api_key.png) 19 | 20 | If you encounter a 401 error message indicating an incorrect API key, please follow these steps: 21 | 22 | 1. Double-check your OpenAI API key: Make sure you have entered the correct API key in the MyToolBelt add-in settings. You can find your API key by logging into your OpenAI account at https://platform.openai.com/account/api-keys 23 | 2. Ensure there are no extra spaces or characters: When copying and pasting your API key, make sure you haven’t accidentally included any extra spaces or characters, as this can cause the key to be recognized as invalid. 24 | 3. Verify your OpenAI API plan: Ensure that your OpenAI API plan is active and supports the features you are trying to access with the AI Companion. 25 | 26 | ### I received an error message regarding an OpenAI request failure with a 429 status code, stating that I exceeded my current quota. I'm using the free credits I received when signing up. What should I do? 27 | ![Exceed Current Quota Error](assets/exceed_current_quota.png) 28 | 29 | If you encounter a 429 error message indicating that you have exceeded your current quota while using the free credits provided upon signing up, please follow these steps: 30 | 31 | 1. Check your OpenAI API usage: Log into your OpenAI account at https://platform.openai.com/account/api-keys and review your API usage to determine if you have indeed exceeded your allotted quota for the current billing period. 32 | 2. Add your billing details: If you have used up your free credits, you will need to add your billing details to your OpenAI account in order to continue using the AI Companion. To do so, visit https://platform.openai.com/billing and enter the required information. 33 | 34 | 35 | 36 | 37 | ## 🤓 Check Out My Excel Add-ins 38 | I've developed some handy Excel add-ins that you might find useful: 39 | 40 | - 📊 **[Dashboard Add-in](https://pythonandvba.com/grafly)**: Easily create interactive and visually appealing dashboards. 41 | - 🎨 **[Cartoon Charts Add-In](https://pythonandvba.com/cuteplots)**: Create engaging and fun cartoon-style charts. 42 | - 🤪 **[Emoji Add-in](https://pythonandvba.com/emojify)**: Add a touch of fun to your spreadsheets with emojis. 43 | - 🛠️ **[MyToolBelt Add-in](https://pythonandvba.com/mytoolbelt)**: A versatile toolbelt for Excel, featuring: 44 | - Creation of Pandas DataFrames and Jupyter Notebooks from Excel ranges 45 | - ChatGPT integration for advanced data analysis 46 | - And much more! 47 | 48 | 49 | 50 | ## 🤝 Connect with Me 51 | - 📺 **YouTube:** [CodingIsFun](https://youtube.com/c/CodingIsFun) 52 | - 🌐 **Website:** [PythonAndVBA](https://pythonandvba.com) 53 | - 💬 **Discord:** [Join our Community](https://pythonandvba.com/discord) 54 | - 💼 **LinkedIn:** [Connect with me](https://www.linkedin.com/in/sven-bosau/) 55 | - 📸 **Instagram:** [Follow me](https://www.instagram.com/codingisfun_official/) 56 | 57 | ## Support My Work 58 | Love my content and want to show appreciation? Why not [buy me a coffee](https://pythonandvba.com/coffee-donation) to fuel my creative engine? Your support means the world to me! 😊 59 | 60 | [![ko-fi](https://ko-fi.com/img/githubbutton_sm.svg)](https://pythonandvba.com/coffee-donation) 61 | 62 | ## Feedback 63 | Got some thoughts or suggestions? Don't hesitate to reach out to me at contact@pythonandvba.com. I'd love to hear from you! 💡 64 | ![Logo](https://www.pythonandvba.com/banner-img) 65 | -------------------------------------------------------------------------------- /assets/ai_companion.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Sven-Bo/Integrate-GPT4-in-Excel-using-VBA/1e98923d23328e65bc9ced90d9d2e472a0fa840e/assets/ai_companion.png -------------------------------------------------------------------------------- /assets/exceed_current_quota.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Sven-Bo/Integrate-GPT4-in-Excel-using-VBA/1e98923d23328e65bc9ced90d9d2e472a0fa840e/assets/exceed_current_quota.png -------------------------------------------------------------------------------- /assets/invalid_api_key.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Sven-Bo/Integrate-GPT4-in-Excel-using-VBA/1e98923d23328e65bc9ced90d9d2e472a0fa840e/assets/invalid_api_key.png -------------------------------------------------------------------------------- /mChatGPT.bas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Sven-Bo/Integrate-GPT4-in-Excel-using-VBA/1e98923d23328e65bc9ced90d9d2e472a0fa840e/mChatGPT.bas --------------------------------------------------------------------------------