如何在 Excel VBA 中对字符串进行 URL 编码? [英] How can I URL encode a string in Excel VBA?

问题描述

是否有内置的方法可以在 Excel VBA 中对字符串进行 URL 编码，还是我需要手动滚动此功能?

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

推荐答案

不，没有内置(直到 Excel 2013 - 看到这个答案).

No, nothing built-in (until Excel 2013 - see this answer).

这个答案中有三个版本的 URLEncode().

There are three versions of URLEncode() in this answer.

• 支持 UTF-8 的函数.您可能应该使用这个(或汤姆的替代实现)以与现代要求兼容.
• 出于参考和教育目的，两个不支持 UTF-8 的函数:
  • 在第三方网站上找到的，按原样包含在内.(这是答案的第一个版本)
  • 我编写的一个优化版本
  • A function with UTF-8 support. You should probably use this one (or the alternative implementation by Tom) for compatibility with modern requirements.
  • For reference and educational purposes, two functions without UTF-8 support:
    • one found on a third party website, included as-is. (This was the first version of the answer)
    • one optimized version of that, written by me

    支持 UTF-8 编码并基于 ADODB.Stream 的变体(包括对项目中Microsoft ActiveX 数据对象"库的最新版本的引用):

    A variant that supports UTF-8 encoding and is based on ADODB.Stream (include a reference to a recent version of the "Microsoft ActiveX Data Objects" library in your project):

    Public Function URLEncode( _
       ByVal StringVal As String, _
       Optional SpaceAsPlus As Boolean = False _
    ) As String
      Dim bytes() As Byte, b As Byte, i As Integer, space As String
    
      If SpaceAsPlus Then space = "+" Else space = "%20"
    
      If Len(StringVal) > 0 Then
        With New ADODB.Stream
          .Mode = adModeReadWrite
          .Type = adTypeText
          .Charset = "UTF-8"
          .Open
          .WriteText StringVal
          .Position = 0
          .Type = adTypeBinary
          .Position = 3 ' skip BOM
          bytes = .Read
        End With
    
        ReDim result(UBound(bytes)) As String
    
        For i = UBound(bytes) To 0 Step -1
          b = bytes(i)
          Select Case b
            Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
              result(i) = Chr(b)
            Case 32
              result(i) = space
            Case 0 To 15
              result(i) = "%0" & Hex(b)
            Case Else
              result(i) = "%" & Hex(b)
          End Select
        Next i
    
        URLEncode = Join(result, "")
      End If
    End Function
    

    <小时>

    这个函数是在freevbcode.com上找到的:

    Public Function URLEncode( _
       StringToEncode As String, _
       Optional UsePlusRatherThanHexForSpace As Boolean = False _
    ) As String
    
      Dim TempAns As String
      Dim CurChr As Integer
      CurChr = 1
    
      Do Until CurChr - 1 = Len(StringToEncode)
        Select Case Asc(Mid(StringToEncode, CurChr, 1))
          Case 48 To 57, 65 To 90, 97 To 122
            TempAns = TempAns & Mid(StringToEncode, CurChr, 1)
          Case 32
            If UsePlusRatherThanHexForSpace = True Then
              TempAns = TempAns & "+"
            Else
              TempAns = TempAns & "%" & Hex(32)
            End If
          Case Else
            TempAns = TempAns & "%" & _
              Right("0" & Hex(Asc(Mid(StringToEncode, _
              CurChr, 1))), 2)
        End Select
    
        CurChr = CurChr + 1
      Loop
    
      URLEncode = TempAns
    End Function
    

    我已经纠正了那里的一个小错误.

    我会使用上述更高效(约 2 倍)的版本:

    I would use more efficient (~2× as fast) version of the above:

    Public Function URLEncode( _
       StringVal As String, _
       Optional SpaceAsPlus As Boolean = False _
    ) As String
    
      Dim StringLen As Long: StringLen = Len(StringVal)
    
      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$(StringVal, 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
    

    请注意，这两个函数都不支持 UTF-8 编码.

    Note that neither of these two functions support UTF-8 encoding.

    这篇关于如何在 Excel VBA 中对字符串进行 URL 编码?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！