China letters from Excel to HTML, handled by VBA

This macros turns Chinese letters in “MS Excel 2007″ spreadsheet to HTML codes. It will works with all Unicode chars, so can be used with Cyrilic, Hebrew, Arab, Japan an all others languages. In my case it prepares XML form and submits it to Zoho application. There can be better way, but I spend good amount of time in Google and can’t find anything usable. Please tell me if you know…

It uses “URLEncode” function, which I find there (thanks, Alexander Buschek !) and improve a bit.

The macros

Sub UpdateZoho()
	Dim i, j, k, onecharcode As Integer
	Dim UpdateUrl, onechar, Request As String
	Dim column, columnName, xmldoc, Status
	Dim bin() As Byte
' Columns in Excel, what will be updates
	column = Array("B", "C", "D", "E", "F")
' Corresponding Zoho reference names
	columnName = Array("Season", "category", "Customer_Goal", "Shape", "Picklist")
	i = 2
	UpdateUrl = "http://creator.zoho.com/api/xml/write/apikey=my_key=my_ticket"
	Request = "<ZohoCreator><applicationlist><application name=""my_app""><formlist><form name=""my_form"">"
' Column "A" is "key_field" in Zoho, no Chinese letters here
	While (Range("A" & i).Value <> "")
	Request = Request & "<update><criteria><field name=""key_field"" compOperator=""Equals"" value=""" & Range("A" & i).Value & """></field></criteria><newvalues>"
	j = 0
	While (j <= UBound(column))
	If (Range(column(j) & i).Value <> "") Then
	Request = Request & "<field name=""" & columnName(j) & """ value="""
' Here starts the magic...
' Turn cell value to binary sequence of decimal codes,
' so Latin chars will be like "code, 0",
' and Chinese - "code1, code2"
	bin() = Range(column(j) & i).Value
	onechar = ""
' step trough binary sequesnce
	For k = LBound(bin) To UBound(bin)
	If onechar = "" Then
' turn DEC to HEX
	onechar = Hex(bin(k))
' remember DEC code, we will need it if the char is Latin
	onecharcode = bin(k)
	Else
' It is Latin, just turn back code to char
	If bin(k) = 0 Then
	Request = Request & Chr(onecharcode)
	Else
' It is Chinese. But codes are swaped, so real code is "code2, code1"
' Actually "code2code1" - two bytes HEX code
	onechar = Hex(bin(k)) & onechar
' But HTML operates with decimals, not HEX...
' Now we have HEX as string, using "&H" will turn the string to "real" HEX code
' And finaly must turn HEX to DEC
' And real finaly, must plase it between delimiters, like "&#deccode;" for HTML
	Request = Request & "&#" & Int("&H" & onechar) & ";"
	End If
	onechar = ""
	End If
' And so on for every byte...
	Next k
	Request = Request & """></field>"
	End If
	j = j + 1
	Wend
	Request = Request & "</newvalues></update>"
	i = i + 1
	Wend
	Request = Request & "</form></formlist></application></applicationlist></ZohoCreator>"
' Encode in URI standards
	Request = "XMLString=" & URLEncode(Request)
' prepare XML object
	Set xmldoc = CreateObject("Microsoft.XMLDOM")
' send request
	xmldoc.LoadXML (urlRequest(UpdateUrl, Request))
' parse answer
	Status = xmldoc.SelectSingleNode("/response/result/form/update/status").text
	If Status = "Success" Then
	MsgBox ("Data saved Successfully !")
	Else
	MsgBox ("Problem ! Changes not saved.")
	End If
End Sub

Function urlRequest(URL, Body) As String
	Dim objHTTP
	Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
	objHTTP.Open "POST", URL, False
	objHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
	objHTTP.send (Body)
	urlRequest = objHTTP.responseText
End Function

Function URLEncode(EncodeStr As String) As String
	Dim i As Integer
	Dim erg As String
	erg = EncodeStr
' *** First replace '%' chr
	erg = Replace(erg, "%", "%25")
' *** then '+' chr
	erg = Replace(erg, "+", "%2B")
	For i = 0 To 255
	Select Case i
' *** Allowed 'regular' characters
	Case 37, 43, 48 To 57, 65 To 90, 97 To 122
	Case 32
	erg = Replace(erg, Chr(i), "+")
	Case 0 To 15
	erg = Replace(erg, Chr(i), "%0" & Hex(i))
	Case Else
	erg = Replace(erg, Chr(i), "%" & Hex(i))
	End Select
	Next
	URLEncode = erg
End Function

Usage

Nothing special: assign it to a button on spreadsheet or event