URLEncode EncodeURL EncodeURI 自定义函数 32\64通用

perfect131

       ENCODEURL 函数返回 URL 编码的字符串，将某些非字母数字字符替换为百分比符号 (%) 和十六进制数字。

       这个论坛已经有各种参考代码 ,最简单的就是 WorksheetFunction.EncodeURL，但这个 需要excel版本兼容 还有字数也有限制。
       用 htmlfile 32/64 通用

1. Function encodeURIComponent(ByVal strText As String) As String     '如果值中带有非英文和数字，则需转换成%形式
   
2.     Set oDom = CreateObject("htmlfile")
   
3.     encodeURIComponent = oDom.parentWindow.encodeURIComponent(strText)
   
4.     Set oDom = Nothing
   
5. End Function

复制代码

     encodeURIComponent 函数 会保留 '(英语单引号），还有 , - _ . ! ~ * ' ( ) 这些 符号，如果不想 保留这些字符 用这个函数

1. Function rfc3986EncodeURIComponent(ByVal strText As String) As String      '如果值中带有非英文和数字，则需转换成%形式
   
2.     Set oDom = CreateObject("htmlfile")
   
3.     oDom.parentWindow.execScript "function rfc3986EncodeURIComponent(str){return encodeURIComponent(str).replace(/[!'()*]/g, escape);};"
   
4.     rfc3986EncodeURIComponent = oDom.parentWindow.rfc3986EncodeURIComponent(strText)
   
5.     Set oDom = Nothing
   
6. End Function

复制代码

参考：https://stackoverflow.com/questi ... -quotes-apostrophes
参考：https://club.excelhome.net/threa ... tml?_dsign=b93d9ebe

EncodeURI ADO  不会保留 '(英语单引号)

1. Function EncodeURI(ss, Optional ByVal CharSet1 As String = "UTF-8") As String
   
2.     On Error GoTo err1
   
3.     Dim ADODB_Stream
   
4.     Set ADODB_Stream = CreateObject("ADODB.Stream")
   
5.     Dim encode() As Byte
   
6.     With ADODB_Stream
   
7.         .Charset = CharSet1
   
8.         .Open
   
9.         .WriteText ss, 0
   
10.         .Position = 0
    
11.         .Type = 1
    
12.         If CharSet1 <> "UTF-8" Then
    
13.             .Position = 0
    
14.         Else
    
15.             .Position = 3 ''无 bom
    
16.         End If
    
17.         encode = .Read()
    
18.         EncodeURI = ""
    
19.         For i = 0 To UBound(encode)
    
20.             EncodeURI = EncodeURI & "%" & Hex(encode(i))
    
21.         Next
    
22.         .Close
    
23.      End With
    
24. err1:
    
25.     Set ADODB_Stream = Nothing
    
26. End Function

复制代码

smiletwo

     

perfect131

只替换 url 中的中文 ，encodeURIhttp

1. Function encodeURIhttp(ByVal strText As String) As String     '''只替换 url 中的中文
   
2.     Set oDom = CreateObject("htmlfile")
   
3.     Set Reg = CreateObject("vbscript.regexp")
   
4.     With Reg
   
5.         .Pattern = "[一-龥]+"
   
6.         .Global = True
   
7.     End With
   
8.     If Reg.test(strText) Then
   
9.         Set MC = Reg.Execute(strText)
   
10.         For Each M In MC
    
11.             strText = Replace(strText, M.Value, oDom.parentWindow.encodeURIComponent(M.Value))
    
12.         Next M
    
13.         encodeURIhttp = strText
    
14.     Else
    
15.         encodeURIhttp = strText
    
16.     End If
    
17.     Set Reg = Nothing
    
18.     Set oDom = Nothing
    
19. End Function

复制代码

https://club.excelhome.net/forum.php?mod=viewthread&tid=1665474&page=1&_dsign=76abaea8