Question

我正在尝试解析VBA中的URL中的参数。例如：

https://www.google.com/webhp?q=vba+url+parameters&utf_source=stackoverflow

我希望得到类似哈希表的东西，q映射到'vba + url + parameters'，utf_source映射到'stackoverflow'。

是否存在现有的数据结构/功能？或者我需要构建一些东西来自己解析它？我查看了MSHTML库，找不到任何明显的东西，MSHTML.HTMLAnchorElement.href属性只返回一个String。

Answer 1

我写了一个通用的Parse函数，它可以处理连接字符串，URL和其他键值类型的字符串。以下是它的工作原理：

Sub TestParse()
Dim s As String

    s = "https://www.google.com/webhp?q=vba+url+parameters&utf_source=stackoverflow"
    Debug.Print Parse(s, "q", vbString, "=", "&")
    Debug.Print Parse(s, "utf_source", vbString, "=", "&")

End Sub

输出：

vba+url+parameters
stackoverflow

这是功能：

'---------------------------------------------------------------------------------------
' Procedure : Parse
' DateTime  : 7/16/2009 11:32
' Author    : Mike
' Purpose   : Parse a string of keys and values (such as a connection string) and return
'               the value of a specific key.
' Usage     - Use to pass multiple arguments to forms via OpenArgs in MS Access
'           - Keep multiple arguments in the Tag property of forms and controls.
'           - Use to parse a user-entered search string.
' Notes     - Defaults to using connection string formatted key-value pairs.
'           - Specifying a ReturnType guarantees the type of the result and allows the
'               function to be safely called in certain situations.
'  7/23/09  : Modified to allow the use of a literal space as a delimiter while allowing
'               values to have spaces as well. 
'---------------------------------------------------------------------------------------
'
Function Parse(Txt As Variant, Key As String, _
               Optional ReturnType As VbVarType = vbVariant, _
               Optional AssignChar As String = "=", _
               Optional Delimiter As String = ";") As Variant    
Dim StartPos As Integer, EndPos As Integer, Result As Variant
    Result = Null
    If IsNull(Txt) Then
        Parse = Null
    ElseIf Len(Key) = 0 Then
        EndPos = InStr(Txt, AssignChar)
        If EndPos = 0 Then
            Result = Trim(Txt)
        Else
            If InStrRev(Txt, " ", EndPos) = EndPos - 1 Then
                EndPos = InStrRev(Txt, Delimiter, EndPos - 2)
            Else
                EndPos = InStrRev(Txt, Delimiter, EndPos)
            End If
            Result = Trim(Left(Txt, EndPos))
        End If
    Else
        StartPos = InStr(Txt, Key & AssignChar)
        'Allow for space between Key and Assignment Character
        If StartPos = 0 Then
            StartPos = InStr(Txt, Key & " " & AssignChar)
            If StartPos > 0 Then StartPos = StartPos + Len(Key & " " & AssignChar)
        Else
            StartPos = StartPos + Len(Key & AssignChar)
        End If
        If StartPos = 0 Then
            Parse = Null
        Else
            EndPos = InStr(StartPos, Txt, AssignChar)
            If EndPos = 0 Then
                If Right(Txt, Len(Delimiter)) = Delimiter Then
                    Result = Trim(Mid(Txt, StartPos, _
                                      Len(Txt) - Len(Delimiter) - StartPos + 1))
                Else
                    Result = Trim(Mid(Txt, StartPos))
                End If
            Else
                If InStrRev(Txt, Delimiter, EndPos) = EndPos - 1 Then
                    EndPos = InStrRev(Txt, Delimiter, EndPos - 2)
                Else
                    EndPos = InStrRev(Txt, Delimiter, EndPos)
                End If
                If EndPos < StartPos Then
                    Result = Trim(Mid(Txt, StartPos))
                Else
                    Result = Trim(Mid(Txt, StartPos, EndPos - StartPos))
                End If
            End If

        End If
    End If
    Select Case ReturnType
    Case vbBoolean
        If IsNull(Result) Or Len(Result) = 0 Or Result = "False" Then
            Parse = False
        Else
            Parse = True
            If IsNumeric(Result) Then
                If Val(Result) = 0 Then Parse = False
            End If
        End If

    Case vbCurrency, vbDecimal, vbDouble, vbInteger, vbLong, vbSingle
        If IsNumeric(Result) Then
            Select Case ReturnType
            Case vbCurrency: Parse = CCur(Result)
            Case vbDecimal: Parse = CDec(Result)
            Case vbDouble: Parse = CDbl(Result)
            Case vbInteger: Parse = CInt(Result)
            Case vbLong: Parse = CLng(Result)
            Case vbSingle: Parse = CSng(Result)
            End Select
        Else
            Select Case ReturnType
            Case vbCurrency: Parse = CCur(0)
            Case vbDecimal: Parse = CDec(0)
            Case vbDouble: Parse = CDbl(0)
            Case vbInteger: Parse = CInt(0)
            Case vbLong: Parse = CLng(0)
            Case vbSingle: Parse = CSng(0)
            End Select
        End If

    Case vbDate
        If IsDate(Result) Then
            Parse = CDate(Result)
        ElseIf IsNull(Result) Then
            Parse = 0
        ElseIf IsDate(Replace(Result, "#", "")) Then
            Parse = CDate(Replace(Result, "#", ""))
        Else
            Parse = 0
        End If

    Case vbString
        Parse = Nz(Result, vbNullString)

    Case Else
        If IsNull(Txt) Then
            Parse = Null
        ElseIf Result = "True" Then
            Parse = True
        ElseIf Result = "False" Then
            Parse = False
        ElseIf IsNumeric(Result) Then
            Parse = Val(Result)
        Else
            Parse = Result
        End If
    End Select
End Function

Answer 2

我认为你想要的是Dictionary对象。

您可以提取问号右侧的所有内容，并将值添加到字典中。

如何在VBA中解析URL参数？

2 个答案: