零售创新,创新那些事

Excel VBA 字符串继续url编码


Excel VBA  url 编码工具,可以把汉字变成ACCII 码

Excel VBA  字符串继续url编码 - 和平 - 零售创新,创新那些事儿,SPSS,VBA

 


Public Function UrlEncode(ByRef szString As String) As String

       Dim szChar   As String

       Dim szTemp   As String

       Dim szCode   As String

       Dim szHex    As String

       Dim szBin    As String

       Dim iCount1  As Integer

       Dim iCount2  As Integer

       Dim iStrLen1 As Integer

       Dim iStrLen2 As Integer

       Dim lResult  As Long

       Dim lAscVal  As Long

       szString = Trim$(szString)

       iStrLen1 = Len(szString)

       For iCount1 = 1 To iStrLen1

           szChar = Mid$(szString, iCount1, 1)

           lAscVal = AscW(szChar)

           If lAscVal >= &H0 And lAscVal <= &HFF Then

              If (lAscVal >= &H30 And lAscVal <= &H39) Or _

                 (lAscVal >= &H41 And lAscVal <= &H5A) Or _

                 (lAscVal >= &H61 And lAscVal <= &H7A) Then

                 szCode = szCode & szChar

              Else

                 szCode = szCode & "%" & Hex(AscW(szChar))

              End If

           Else

              szHex = Hex(AscW(szChar))

              iStrLen2 = Len(szHex)

              For iCount2 = 1 To iStrLen2

                  szChar = Mid$(szHex, iCount2, 1)

                  Select Case szChar

                         Case Is = "0"

                              szBin = szBin & "0000"

                         Case Is = "1"

                              szBin = szBin & "0001"

                         Case Is = "2"

                              szBin = szBin & "0010"

                         Case Is = "3"

                              szBin = szBin & "0011"

                         Case Is = "4"

                              szBin = szBin & "0100"

                         Case Is = "5"

                        szBin = szBin & "0101"

                         Case Is = "6"

                              szBin = szBin & "0110"

                         Case Is = "7"

                              szBin = szBin & "0111"

                         Case Is = "8"

                              szBin = szBin & "1000"

                         Case Is = "9"

                              szBin = szBin & "1001"

                         Case Is = "A"

                              szBin = szBin & "1010"

                         Case Is = "B"

                              szBin = szBin & "1011"

                         Case Is = "C"

                              szBin = szBin & "1100"

                         Case Is = "D"

                              szBin = szBin & "1101"

                         Case Is = "E"

                              szBin = szBin & "1110"

                         Case Is = "F"

                              szBin = szBin & "1111"

                         Case Else

                  End Select

              Next iCount2

              szTemp = "1110" & Left$(szBin, 4) & "10" & Mid$(szBin, 5, 6) & "10" & Right$(szBin, 6)

              For iCount2 = 1 To 24

                  If Mid$(szTemp, iCount2, 1) = "1" Then

                     lResult = lResult + 1 * 2 ^ (24 - iCount2)

                  Else: lResult = lResult + 0 * 2 ^ (24 - iCount2)

                  End If

              Next iCount2

              szTemp = Hex(lResult)

                    szCode = szCode & "%" & Left$(szTemp, 2) & "%" & Mid$(szTemp, 3, 2) & "%" & Right$(szTemp, 2)

           End If           

szBin = vbNullString

           lResult = 0

       Next iCount1

       UrlEncode = szCode

       End Function


测试

定义完之后,我们选择菜单->文件->关闭并返回Excel。然后我们就可以在Excel中测试刚才定义的这个函数了。如下图所示。

Excel VBA  字符串继续url编码 - 和平 - 零售创新,创新那些事儿,SPSS,VBA

 


评论