אם יש לך עוד בעיות,
השתמש אולי בקוד זה (אצלי עובד מצויין):
Private Const CP_UTF8 = 65001
Private Declare PtrSafe Function WideCharToMultiByte Lib "Kernel32" (ByVal CodePage As Long, ByVal dwflags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
Public Function UTF16To8(ByVal UTF16 As String) As String
Dim sBuffer As String
Dim lLength As Long
If UTF16 <> "" Then
lLength = WideCharToMultiByte(CP_UTF8, 0, CLng(StrPtr(UTF16)), -1, 0, 0, 0, 0)
sBuffer = Space$(lLength)
lLength = WideCharToMultiByte(CP_UTF8, 0, CLng(StrPtr(UTF16)), -1, CLng(StrPtr(sBuffer)), Len(sBuffer), 0, 0)
sBuffer = StrConv(sBuffer, vbUnicode)
UTF16To8 = Left$(sBuffer, lLength - 1)
Else
UTF16To8 = ""
End If
End Function
Public Function URLEncode( _
StringVal As String, _
Optional SpaceAsPlus As Boolean = False, _
Optional UTF8Encode As Boolean = True _
) As String
Dim StringValCopy As String: StringValCopy = IIf(UTF8Encode, UTF16To8(StringVal), StringVal)
Dim StringLen As Long: StringLen = Len(StringValCopy)
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$(StringValCopy, 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
לקוח מפה http://stackoverflow.com/questions/218181/how-can-i-url-encode-a-string-in-excel-vba
עם התאמות קלות ל64 ביט.
פורסם במקור בפורום CODE613 ב31/07/2013 17:59 (+03:00)
