为了让这个内容保持最新状态，自从Excel 2013以来，现在有一种内置的方法可以使用工作表函数ENCODEURL对URL进行编码。

要在您的VBA代码中使用它，您只需要调用

EncodedUrl = WorksheetFunction.EncodeUrl(InputString)

文档

不，没有内置的（直到Excel 2013 - 请见此回答）。

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

• 带有UTF-8支持的函数。您应该使用此函数（或者Tom的另一种实现）以兼容现代要求。
• 出于参考和教育目的，两个不带UTF-8支持的函数：
  • 第三方网站上发现的一个函数（作为原样包含）。 （这是答案的第一个版本）
  • 我编写的那个的优化版本

一种支持UTF-8编码且基于ADODB.Stream的变体（在您的项目中包含对最新版本的“Microsoft ActiveX Data Objects”库的引用）：

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倍）的版本：

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编码。