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