Created
May 3, 2011 21:09
-
-
Save dtjohnso/954247 to your computer and use it in GitHub Desktop.
Trying to grab XRECORD via MARC callnum
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
'Similar to Query, but using WinHttpRequest 5.1 | |
Private Function HttpRequest(url As String) As String | |
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1") | |
objHTTP.Open "GET", url, False | |
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)" | |
objHTTP.send ("") | |
HttpRequest = objHTTP.responseText | |
End Function | |
Private Sub testget() | |
'Debug.Print HttpRequest("http://library.bju.edu:81/search/c?01187632") | |
'Debug.Print HttpRequest("http://library.bju.edu:81/xrecord=b1117110") | |
'Debug.Print RetrieveItemXML("01187632") | |
'ParseXML RetrieveItemXML("01187632") | |
ParseXML RetrieveItemXML("226.506 K848t") | |
End Sub | |
'Retrieves the XML bib data for an item based on the MARC call number | |
Private Function RetrieveItemXML(sCallNum As String) As String | |
Dim sCallNumURL As String | |
Dim sRecordURL As String | |
Dim sHtmlRecord As String | |
Dim sBibIdNum As String | |
Dim sXmlRecord As String | |
'Retrieve HTML record from MARC call number | |
'sCallNumURL = "http://library.bju.edu:81/search/c?" + sCallNum | |
sCallNumURL = "http://library.bju.edu/search/c?" + sCallNum | |
sHtmlRecord = HttpRequest(sCallNumURL) | |
'Retrieve XML from Millennium bibId | |
sBibIdNum = RegExpFind(RegExpFind(sHtmlRecord, "/record=b[0-9]+~"), "b[0-9]+") | |
'sRecordURL = "http://library.bju.edu:81/xrecord=" + sBibIdNum | |
sRecordURL = "http://library.bju.edu/xrecord=" + sBibIdNum | |
sXmlRecord = Replace(HttpRequest(sRecordURL), "bju.edu:81", "bju.edu") 'replace is necessary because DTD does not live at bju.edu:81 but bju.edu | |
'Return | |
RetrieveItemXML = sXmlRecord | |
End Function | |
Private Sub ParseXML(sXmlRecord As String) | |
Dim objXML As MSXML2.DOMDocument | |
Set objXML = New MSXML2.DOMDocument | |
Debug.Print sXmlRecord | |
If objXML.loadXML(sXmlRecord) = 0 Then 'strXML is the string with XML | |
Err.Raise objXML.parseError.errorCode, , objXML.parseError.reason | |
End If | |
Dim point As IXMLDOMNode | |
Set point = objXML.FirstChild | |
Debug.Print point.selectSingleNode("RECORDINFO").text | |
End Sub | |
Public Function RegExpFind(LookIn As String, PatternStr As String, Optional MatchCase As Boolean = True) As String | |
Dim RegX As Object | |
Dim Match, Matches | |
Dim lastMatch As String | |
Set RegX = CreateObject("VBScript.RegExp") | |
With RegX | |
.Pattern = PatternStr | |
.Global = True | |
.IgnoreCase = Not MatchCase | |
End With | |
Set Matches = RegX.Execute(LookIn) | |
For Each Match In Matches | |
'Debug.Print Match.FirstIndex | |
'Debug.Print Match.Value | |
lastMatch = Match.Value | |
Next Match | |
'RegExpReplace = RegX.Replace(LookIn, ReplaceWith) | |
Set RegX = Nothing | |
RegExpFind = lastMatch | |
End Function |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment