Excel中使用VBA自定义函数对字符串进行Url编码（中文->url）

第一步：打开excel，按ALT+F11，选择界面出现的插入按钮，选择插入模块并复制下面代码
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函数的调用一样 =UrlEncode（A1）