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

问题描述

解决方案

是否有内置的方式来对Excel VBA中的字符串进行URL编码？

不，没有内置（直到Excel 2013 - 查看此答案 ）。

此答案中有三个版本的 URLEncode（）。

• 支持UTF-8的功能。 您应该可以使用这一个（或者， Tom的替代实现）来满足现代要求。


• 为了参考和教育目的，有两个不支持UTF-8功能的功能：
  
  
  
  
  • 网站，按原样包含。 （这是答案的第一个版本）
  
  
  • 由我写的一个优化版本
  
  

---

支持UTF-8编码的变体，基于 ADODB.Stream （包括对项目中最近版本的Microsoft ActiveX数据对象库的引用）：

 公共函数URLEncode（_ 
 StringVal As String，_ 
可选SpaceAsPlus As Boolean = False _ 
）As String 
 Dim bytes（）As Byte，b As Byte，i As Integer ，space As String 
 
如果SpaceAsPlus Then space =+Else space =％20
 
如果Len（StringVal）> 0然后
使用新的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结果（UBound（bytes））As String 
 
对于i = UBound（bytes）To 0 Step -1 
b = bytes（i）
选择案例b 
案例97至122,65至90,48至57,45,46,95,126 
结果（i）= Chr（b）
案例32 
结果（i）=空格
案例0到15 
 result（i）=％0& Hex（b）
 Case Else 
 result（i）=％&十六进制（b）
结束选择
 Next i 
 
 URLEncode = Join（result，）
 End If 
 End Function 
  

---

此功能是在freevbcode.com上找到：

  public function URLEncode（_ 
 StringToEncode As String，_ 
可选UsePlusRatherThanHexForSpace As Boolean = False _ 
）As String 
 
 Dim TempAns As String 
 Dim CurChr As Integer 
 CurChr = 1 
 
直到CurChr  -  1 = Len（StringToEncode）
选择案例Asc（Mid（StringToEncode，CurChr，1））
案例48至57，65至90，97至122 
 TempAns = TempAns& Mid（StringToEncode，CurChr，1）
案例32 
如果UsePlusRatherThanHexForSpace = True然后
 TempAns = TempAns& +
 Else 
 TempAns = TempAns& ％& Hex（32）
 End If 
 Case Else 
 TempAns = TempAns& ％& _ 
右（0& Hex（Asc（Mid（StringToEncode，_ 
 CurChr，1））），2）
结束选择
 
 CurChr = CurChr + 1 
循环
 
 URLEncode = TempAns 
结束函数
  

我已经纠正了一个小错误。

---

我将使用更高效（〜2×快）版本的上述：

 公共功能URLEncode（_ 
 StringVal As String，_ 
可选SpaceAsPlus As Boolean = False _ 
）As String 
 
 Dim StringLen As Long：StringLen = Len（StringVal）
 
如果StringLen> 0然后
 ReDim result（StringLen）As String 
 Dim i As Long，CharCode As Integer 
 Dim Char As String，Space As String 
 
如果SpaceAsPlus Then Space = +Else Space =％20
 
对于i = 1 To StringLen 
 Char = Mid $（StringVal，i，1）
 CharCode = Asc（Char）
选择案例CharCode 
案例97到122，65到90，48到57，45，46，95，126 
结果（i）= Char 
案例32 
结果（i）=空格
案例0到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编码。

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

解决方案

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

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

• 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

---

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( _
   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

---

This function was found on 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

I've corrected a little bug that was in there.

---

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

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

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