3
votes

I have the code below:

Option Explicit
Dim myURL,oXMLHttp,objFSO,Description,write2File,ws
myURL = "https://www.cbsnews.com/latest/rss/main"
Set ws = CreateObject("wscript.shell")
Set oXMLHttp = CreateObject("MSXML2.XMLHTTP")
Set objFSO = CreateObject("Scripting.FileSystemObject")
oXMLHttp.Open "GET", myURL, False
oXMLHttp.Send

If oXMLHttp.Status = 200 Then
    Description = Extract(oXMLHttp.responseText)
    Set write2File = objFSO.CreateTextFile(".\Description.txt", True)
    write2File.WriteLine(Description)
    write2File.Close
End If

Function Extract(Data)  
    Dim re, Match, Matches
    Set re = New RegExp 
    re.Global = True 
    re.IgnoreCase = True  
    re.MultiLine = True
    re.Pattern = "<description>([\s\S]*?)<\/description>" 
    Set Matches = re.Execute(Data)
    For Each Match in Matches
        Description = Description & Match.SubMatches(0) & vbCrLf & vbCrLf
    Next  
    Extract = Description
End Function

Now I need to save the title and description with two different patterns in the same text file. For exemple:

re.Pattern = "<title>([\s\S]*?)<\/title>" 'pattern 01
re.Pattern = "<description>([\s\S]*?)<\/description>" 'pattern 02

How it should be saved in the text file (exemple):

line 01: Text between tag "title"
line 02: Text between tag "description"

line 03: Text between tag "title"
line 04: Text between tag "description"

etc.

I tried a Forinside another For, but the result was not as expected, because I think I'm missing something.

2

2 Answers

3
votes

Use an alternation:

re.Pattern = "<title>([\s\S]*?)</title>|<description>([\s\S]*?)</description>"

and append the respective submatch:

If Not IsEmpty(Match.SubMatches(0)) Then
    Description = Description & Match.SubMatches(0)
ElseIf Not IsEmpty(Match.SubMatches(1)) Then
    Description = Description & Match.SubMatches(1)
End If
3
votes

Do you need read and parse xml ?

function Extract(Data)
    Set doc = CreateObject("MSXML2.DOMDocument") 
    doc.loadXML(Data)
    If doc.parseError <> 0 Then
        response.write doc.parseError.reason
        response.end
    end if
    Description = ""
    For Each node In doc.selectNodes("/rss/channel/item")
        if not node.selectSingleNode("title") is Nothing then
            Description = Description & node.selectSingleNode("title").text & vbCrlf & vbCrlf
        end if
        if not node.selectSingleNode("description") is Nothing then
            Description = Description & node.selectSingleNode("description").text & vbCrlf & vbCrlf
        end if
        Description = Description & vbCrlf & vbCrlf
    Next
    Extract = Description 
end function