How can I URL encode a string in Excel VBA?

后端 未结 15 2214
闹比i
闹比i 2020-11-22 11:39

Is there a built-in way to URL encode a string in Excel VBA or do I need to hand roll this functionality?

15条回答
  •  轮回少年
    2020-11-22 12:10

    Same as WorksheetFunction.EncodeUrl with UTF-8 support:

    Public Function EncodeURL(url As String) As String
      Dim buffer As String, i As Long, c As Long, n As Long
      buffer = String$(Len(url) * 12, "%")
    
      For i = 1 To Len(url)
        c = AscW(Mid$(url, i, 1)) And 65535
    
        Select Case c
          Case 48 To 57, 65 To 90, 97 To 122, 45, 46, 95  ' Unescaped 0-9A-Za-z-._ '
            n = n + 1
            Mid$(buffer, n) = ChrW(c)
          Case Is <= 127            ' Escaped UTF-8 1 bytes U+0000 to U+007F '
            n = n + 3
            Mid$(buffer, n - 1) = Right$(Hex$(256 + c), 2)
          Case Is <= 2047           ' Escaped UTF-8 2 bytes U+0080 to U+07FF '
            n = n + 6
            Mid$(buffer, n - 4) = Hex$(192 + (c \ 64))
            Mid$(buffer, n - 1) = Hex$(128 + (c Mod 64))
          Case 55296 To 57343       ' Escaped UTF-8 4 bytes U+010000 to U+10FFFF '
            i = i + 1
            c = 65536 + (c Mod 1024) * 1024 + (AscW(Mid$(url, i, 1)) And 1023)
            n = n + 12
            Mid$(buffer, n - 10) = Hex$(240 + (c \ 262144))
            Mid$(buffer, n - 7) = Hex$(128 + ((c \ 4096) Mod 64))
            Mid$(buffer, n - 4) = Hex$(128 + ((c \ 64) Mod 64))
            Mid$(buffer, n - 1) = Hex$(128 + (c Mod 64))
          Case Else                 ' Escaped UTF-8 3 bytes U+0800 to U+FFFF '
            n = n + 9
            Mid$(buffer, n - 7) = Hex$(224 + (c \ 4096))
            Mid$(buffer, n - 4) = Hex$(128 + ((c \ 64) Mod 64))
            Mid$(buffer, n - 1) = Hex$(128 + (c Mod 64))
        End Select
      Next
    
      EncodeURL = Left$(buffer, n)
    End Function
    

提交回复
热议问题