Question

尝试修改我在Excel中的宏，我遇到了问题。我收到消息＆＃34;编译错误：预期：列表分隔符＆＃34;

这是工作的vba代码

Sub GetTitles()
    Dim c As Range, url As String
    For Each c In Columns("B").Cells
        url = Trim(c.Value)
        If LCase(url) Like "http://*" Then
            c.Offset(0, 4).Value = GetTitle(url)
        End If
    Next c
End Sub
Function GetTitle(sURL As String)
    Dim title As String, res As String, pos1, pos2
    Dim objHttp As Object
    Set objHttp = CreateObject("MSXML2.ServerXMLHTTP")
    objHttp.Open "GET", sURL, False
    objHttp.Send ""

    res = objHttp.ResponseText
    pos1 = InStr(1, UCase(res), "<TITLE>")
    pos2 = InStr(1, UCase(res), "</TITLE>")

    title = ""
    If pos1 > 0 And pos2 > 0 Then
        pos1 = pos1 + Len("<TITLE>")
        title = Mid(res, pos1, pos2 - pos1)
    End If
    GetTitle = title
End Function

它非常适合获取HTML页面列表的标题。我希望扩展功能并获得页面的描述。示例元描述标记与此<meta name="dcterms.description" content="Description of Page"/>

类似

如果我修改那个sub并且功能如此，那就是我收到错误。

Sub GetDesc()
    Dim c As Range, url As String
    For Each c In Columns("B").Cells
        url = Trim(c.Value)
        If LCase(url) Like "http://*" Then
            c.Offset(0, 4).Value = GetDesc(url)
        End If
    Next c
End Sub
Function GetDesc(sURL As String)
    Dim title As String, res As String, pos1, pos2
    Dim objHttp As Object
    Set objHttp = CreateObject("MSXML2.ServerXMLHTTP")
    objHttp.Open "GET", sURL, False
    objHttp.Send ""

    res = objHttp.ResponseText
    pos1 = InStr(1, UCase(res), "<meta name="dcterms.description" content="")
    pos2 = InStr(1, UCase(res), ""/>")

    title = ""
    If pos1 > 0 And pos2 > 0 Then
        pos1 = pos1 + Len("<TITLE>")
        title = Mid(res, pos1, pos2 - pos1)
    End If
    GetTitle = title
End Function

那么我该如何解决这个问题呢？

谢谢！

Answer 1

你需要将它们在VBA中引用字符串中的引号加倍 - 所以：

pos1 = InStr(1, LCase(res), "<meta name=""dcterms.description"" content=""")
pos2 = InStr(pos1, LCase(res), """/>")

Answer 2

现在无法测试，但这应该可以解决问题。如果它做得很好，也许你会知道它是如何工作的。所以我将尝试解释这段代码实际上做了什么。

它查找字符串[content =“]的位置和字符串[”/＆gt;]的位置，删除这些字符串之间的任何内容并将其放入[title]（您可能想要的名称）变化）

res = objHttp.ResponseText
pos1 = InStr(1, res, "content=""")
pos2 = InStr(1, res, """/>")

title = ""
If pos1 > 0 And pos2 > 0 Then
    pos1 = pos1 + Len("content=""")
    title = Mid(res, pos1, pos2 - pos1)
End If
'dont forget to change the function name
'and change it to something different to your sub name
GetDescr = title

End Function

编译错误预期列表分隔符

2 个答案: