VBA 是否有任何内置的 URL 解码？

Does VBA have any built in URL decoding?

提问by Russell Steen

I just need to decode a URL, for example, replace %2E with . I can hack out a method if one isn't build in, but my assumption is that there must be a URL decoding tool already existing.

我只需要解码一个 URL，例如，将 %2E 替换为 . 如果没有内置方法，我可以破解一种方法，但我的假设是必须已经存在一个 URL 解码工具。

采纳答案by Mitch Wheat

No.

不。

But here's one: URL Encoder and Decoder for VB

但这里有一个：用于 VB 的 URL 编码器和解码器

Or something along the lines of (possibly not complete):

或者类似的东西（可能不完整）：

Public Function URLDecode(ByVal strEncodedURL As String) As String
   Dim str As String
   str = strEncodedURL 
   If Len(str) > 0 Then
      str = Replace(str, "&amp", " & ")
      str = Replace(str, "&#03", Chr(39))
      str = Replace(str, "&quo", Chr(34))
      str = Replace(str, "+", " ")
      str = Replace(str, "%2A", "*")
      str = Replace(str, "%40", "@")
      str = Replace(str, "%2D", "-")
      str = Replace(str, "%5F", "_")
      str = Replace(str, "%2B", "+")
      str = Replace(str, "%2E", ".")
      str = Replace(str, "%2F", "/")

      URLDecode = str
  End If

End Function

Also, take a look at How can I URL encode a string in Excel VBA?

另外，看看如何在 Excel VBA 中对字符串进行 URL 编码？

回答by markus diersbock

Here's a snippet I wrote years ago

这是我多年前写的片段

-markus

-马库斯

Public Function URLDecode(sEncodedURL As String) As String

On Error GoTo Catch

Dim iLoop   As Integer
Dim sRtn    As String
Dim sTmp    As String

If Len(sEncodedURL) > 0 Then
    ' Loop through each char
    For iLoop = 1 To Len(sEncodedURL)
        sTmp = Mid(sEncodedURL, iLoop, 1)
        sTmp = Replace(sTmp, "+", " ")
        ' If char is % then get next two chars
        ' and convert from HEX to decimal
        If sTmp = "%" and LEN(sEncodedURL) + 1 > iLoop + 2 Then
            sTmp = Mid(sEncodedURL, iLoop + 1, 2)
            sTmp = Chr(CDec("&H" & sTmp))
            ' Increment loop by 2
            iLoop = iLoop + 2
        End If
        sRtn = sRtn & sTmp
    Next
    URLDecode = sRtn
End If

Finally:
    Exit Function
Catch:
    URLDecode = ""
    Resume Finally
End Function

回答by konahn

EncodeURL and DecodeURL function using htmlfile object(Late binding)

使用 htmlfile 对象的 EncodeURL 和 DecodeURL 函数（后期绑定）

I got this source from this site: http://cocosoft.kr/442

我从这个网站得到了这个来源：http: //cocosoft.kr/442

Function ENCODEURL(varText As Variant, Optional blnEncode = True)
    Static objHtmlfile As Object
    If objHtmlfile Is Nothing Then
        Set objHtmlfile = CreateObject("htmlfile")
        With objHtmlfile.parentWindow
            .execScript "function encode(s) {return encodeURIComponent(s)}", "jscript"
        End With
    End If
    If blnEncode Then
        ENCODEURL = objHtmlfile.parentWindow.encode(varText)
    End If
End Function

Function DECODEURL(varText As Variant, Optional blnEncode = True)
    Static objHtmlfile As Object
    If objHtmlfile Is Nothing Then
        Set objHtmlfile = CreateObject("htmlfile")
        With objHtmlfile.parentWindow
            .execScript "function decode(s) {return decodeURIComponent(s)}", "jscript"
        End With
    End If
    If blnEncode Then
        DECODEURL = objHtmlfile.parentWindow.decode(varText)
    End If
End Function

For example,

例如，

str = ENCODEURL("/?&=") 'returns "%2F%3F%26%3D"
str = DECODEURL("%2F%3F%26%3D") 'returns "/?&="

回答by FreeSoftwareServers

Here is the code from the URL posted in another answer in case it goes down as it works great.

这是另一个答案中发布的 URL 中的代码，以防它在运行良好时出现故障。

http://www.freevbcode.com/ShowCode.asp?ID=1512

http://www.freevbcode.com/ShowCode.asp?ID=1512

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 & "%" & _
              Format(Hex(Asc(Mid(StringToEncode, _
              CurChr, 1))), "00")
End Select

  CurChr = CurChr + 1
Loop

URLEncode = TempAns
End Function


Public Function URLDecode(StringToDecode As String) As String

Dim TempAns As String
Dim CurChr As Integer

CurChr = 1

Do Until CurChr - 1 = Len(StringToDecode)
  Select Case Mid(StringToDecode, CurChr, 1)
    Case "+"
      TempAns = TempAns & " "
    Case "%"
      TempAns = TempAns & Chr(Val("&h" & _
         Mid(StringToDecode, CurChr + 1, 2)))
       CurChr = CurChr + 2
    Case Else
      TempAns = TempAns & Mid(StringToDecode, CurChr, 1)
  End Select

CurChr = CurChr + 1
Loop

URLDecode = TempAns
End Function


' URLDecode function in Perl for reference
' both VB and Perl versions must return same
'
' sub urldecode{
'  local($val)=@_;
'  $val=~s/\+/ /g;
'  $val=~s/%([0-9A-H]{2})/pack('C',hex())/ge;
'  return $val;
' }