Added UrlEncode

Added UrlEncode function as that's not available in Excel 2010-.

Author: krijnsent

ModExchCryptopia.bas

@@ -53,14 +53,15 @@ Function PrivateCryptopia(Method As String, apikey As String, secretkey As Strin
 
 Dim NonceUnique As String
 Dim postdata As String
+Dim Url As String
 
 'Cryptopia nonce
 NonceUnique = DateDiff("s", "1/1/1970", Now)
 
 TradeApiSite = "https://www.cryptopia.co.nz"
 urlPath = "/api/"
 Url = TradeApiSite & urlPath & Method
-UrlEnc = LCase(WorksheetFunction.EncodeURL(Url))
+UrlEnc = LCase(URLEncode(Url))
 
 postdata = MethodOptions '{"Currency":""}
 postdataJsonTxt = Replace(postdata, "=", Chr(34) & ":" & Chr(34))

ModFunctions.bas

@@ -22,12 +22,42 @@ Function TransposeArr(ArrIn As Variant)
     Dim TempArr As Variant
 
     ReDim TempArr(1 To UBound(ArrIn, 2), 1 To UBound(ArrIn, 1))
-    For I = 1 To UBound(ArrIn, 2)
+    For i = 1 To UBound(ArrIn, 2)
         For j = 1 To UBound(ArrIn, 1)
-            TempArr(I, j) = ArrIn(j, I)
+            TempArr(i, j) = ArrIn(j, i)
         Next
     Next
 
     TransposeArr = TempArr
 
 End Function
+
+Public Function URLEncode(StringVal As String, Optional SpaceAsPlus As Boolean = False) As String
+'https://stackoverflow.com/questions/218181/how-can-i-url-encode-a-string-in-excel-vba
+  Dim StringLen As Long: StringLen = Len(StringVal)
+
+  If StringLen > 0 Then
+    ReDim result(StringLen) As String
+    Dim i As Long, CharCode As Integer
+    Dim Char As String, Space As String
+
+    If SpaceAsPlus Then Space = "+" Else Space = "%20"
+
+    For i = 1 To StringLen
+      Char = Mid$(StringVal, i, 1)
+      CharCode = Asc(Char)
+      Select Case CharCode
+        Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
+          result(i) = Char
+        Case 32
+          result(i) = Space
+        Case 0 To 15
+          result(i) = "%0" & Hex(CharCode)
+        Case Else
+          result(i) = "%" & Hex(CharCode)
+      End Select
+    Next i
+    URLEncode = Join(result, "")
+  End If
+End Function
+

ModHash.bas

@@ -183,15 +183,15 @@ Function Base64Encode(inData)
   'rfc1521
   '2001 Antonin Foller, Motobit Software, http://Motobit.cz
   Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
-  Dim cOut, sOut, I
+  Dim cOut, sOut, i
 
   'For each group of 3 bytes
-  For I = 1 To Len(inData) Step 3
+  For i = 1 To Len(inData) Step 3
     Dim nGroup, pOut, sGroup
 
     'Create one long from this 3 bytes.
-    nGroup = &H10000 * Asc(Mid(inData, I, 1)) + _
-      &H100 * MyASC(Mid(inData, I + 1, 1)) + MyASC(Mid(inData, I + 2, 1))
+    nGroup = &H10000 * Asc(Mid(inData, i, 1)) + _
+      &H100 * MyASC(Mid(inData, i + 1, 1)) + MyASC(Mid(inData, i + 2, 1))
 
     'Oct splits the long To 8 groups with 3 bits
     nGroup = Oct(nGroup)

ModJSON.bas

@@ -213,19 +213,19 @@ Function MaxDepth(ObjIn As Object, Optional MaxLvl As Integer = 1, Optional Node
     If TypeName(ObjIn) = "Collection" Then
         'arrays ([]) to collections, arrays only have values
         Set CollIn = ObjIn
-        For I = 1 To CollIn.Count
+        For i = 1 To CollIn.Count
             'item could be value, object or array, determine:
             Set iO = Nothing
             On Error Resume Next
-            Set iO = CollIn(I)
+            Set iO = CollIn(i)
             On Error GoTo 0
 
             'item/value
             If Not (iO Is Nothing) Then
                 If NodeLvl + 1 > MaxLvl Then MaxLvl = NodeLvl + 1
                 NextLvl = MaxDepth(iO, MaxLvl, NodeLvl + 1)
             End If
-        Next I
+        Next i
     ElseIf TypeName(ObjIn) = "Dictionary" Then
         'objects ({}) to dictionaries, Objects have key:values
         Set DictIn = ObjIn
@@ -273,13 +273,13 @@ Function JsonToArray(ObjIn As Object, Optional ParentKey As String = "MAIN", Opt
     If TypeName(ObjIn) = "Collection" Then
         'arrays ([]) to collections, arrays only have values
         Set CollIn = ObjIn
-        For I = 1 To CollIn.Count
+        For i = 1 To CollIn.Count
             'item could be value, object or array, determine:
             iV = ""
             Set iO = Nothing
             On Error Resume Next
-            iV = CollIn(I)
-            Set iO = CollIn(I)
+            iV = CollIn(i)
+            Set iO = CollIn(i)
             On Error GoTo 0
 
             'item/value
@@ -288,23 +288,23 @@ Function JsonToArray(ObjIn As Object, Optional ParentKey As String = "MAIN", Opt
                 ReDim Preserve ResArr(1 To 5, 1 To UBound(ResArr, 2) + 1)
                 ResArr(1, UBound(ResArr, 2)) = NodeLvl
                 ResArr(2, UBound(ResArr, 2)) = ParentKey
-                ResArr(3, UBound(ResArr, 2)) = I
+                ResArr(3, UBound(ResArr, 2)) = i
                 ResArr(4, UBound(ResArr, 2)) = iO.Count
                 ResArr(5, UBound(ResArr, 2)) = "OBJ"
                 'Debug.Print "LVL: " & NodeLvl & ", PARENT: " & ParentKey & " , KEY: " & I & " VALUE: count: " & iO.Count & " , TYPE:OBJ"
-                ParentKey = I
-                NextLvl = JsonToArray(iO, str(I), NodeLvl + 1, ResArr)
+                ParentKey = i
+                NextLvl = JsonToArray(iO, str(i), NodeLvl + 1, ResArr)
             Else
                 'item, write simple value
                 'Debug.Print "LVL: " & NodeLvl & ", PARENT: " & ParentKey & " , KEY: " & I & " VALUE:" & iV & " , TYPE:VAL"
                 ReDim Preserve ResArr(1 To 5, 1 To UBound(ResArr, 2) + 1)
                 ResArr(1, UBound(ResArr, 2)) = NodeLvl
                 ResArr(2, UBound(ResArr, 2)) = ParentKey
-                ResArr(3, UBound(ResArr, 2)) = I
+                ResArr(3, UBound(ResArr, 2)) = i
                 ResArr(4, UBound(ResArr, 2)) = iV
                 ResArr(5, UBound(ResArr, 2)) = "VAL"
             End If
-        Next I
+        Next i
     ElseIf TypeName(ObjIn) = "Dictionary" Then
         'objects ({}) to dictionaries, Objects have key:values
         Set DictIn = ObjIn

crypto_vba_example.xlsm

@@ -43,6 +43,7 @@ Import the .bas files you need or simply take the sample Excel file. In the modu
 - Build the Coinone API connector
 - Build the Cryptopia API connector
 - Build a working and tested VBA hash function
+- Added the UrlEncode function for Cryptopia
 
 # Donate
 If this project/the Excel saves you a lot of programming time, consider sending me a coffee or a beer:<br/>