Dear Mr. Trimmell:
My apologies. I have two versions of this process - one using Z39.50, one
using SRU/SRW. It is the latter that actually has an issue...
Here is the code. Apologies for the length...
Cheers!
Fred
Option Compare Database
Option Explicit
Private Sub Command141_Click()
'On Error GoTo Errorhandler
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rs1 As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("tblISBN")
Set rs1 = db.OpenRecordset("tblLibrary")
rs.MoveFirst
Do Until rs.EOF
'Add and populate a new record for each ISBN in tblISBN...
rs1.AddNew
' Now, download a MARC record from the Library of Congress, using SRU/SRW.
' Marc records can be downloaded in XML, and parsed with XML methods. (UK =
Library of Congress)
Dim oLOCXML As Object
Dim oLOCDom As Object
Dim strLOCXML As String
Dim strLOCURL As String
Dim strLOCResponse As String
Dim intLength As Integer
Dim lngI As Long
Set oLOCXML = CreateObject("Microsoft.XMLHTTP")
'This SRU/SRW URL does a search of the library of Congress for a single
record only, based on ISBN,
' and returns an XML version of the MARC record.
strLOCURL =
"
http://z3950.loc.gov:7090/voyager?version=1.1&operation=searchRetrieve&query=bath.isbn="
& rs!ISBN & "&maximumRecords=1"
'***** This inserts a one second delay in code - it fixes error.
Call sSleep(1000)
'*****
'Call the Library of Congress server...
With oLOCXML
.Open "GET", strLOCURL, False
'Needed so web service will recognize get/post
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.send
End With
'Get the results
strLOCResponse = oLOCXML.responseText
'Load the results into a new XML document
Set oLOCDom = CreateObject("MSXML.DOMDocument")
oLOCDom.loadXML (strLOCResponse)
' Check that the Library of Congress Z39.50 server has returned a record
' If the server is down, then don't try to process the returned XML, since
' it contains only an error message.
If Not oLOCDom.documentelement.selectSingleNode("//zs:numberOfRecords") Is
Nothing Then
If oLOCDom.documentelement.selectSingleNode("//zs:numberOfRecords").Text
= "0" Then
'If there is a message from the Library of Congress server display
it...
If Not oLOCDom.documentelement.selectSingleNode("//message") Is
Nothing Then
'MsgBox
oLOCDom.documentelement.selectSingleNode("//message").Text & vbCrLf &
oLOCDom.documentelement.selectSingleNode("//details").Text, vbCritical,
"Error: Library of Congress"
Else
'If there isn't a message from the Library of Congress server,
display a generic error message.
'MsgBox "No matching records were found.", vbCritical, "Error:
Library of Congress"
End If
'Me.Undo
'rs1!AccompanyingItems.SetFocus
Else
'ISBN Number: Tag field 020; Subfield$a;
If Not
oLOCDom.documentelement.selectSingleNode("//datafield[@tag='020']/subfield[@code='a']/text()")
Is Nothing Then
rs1!ISBN =
Left(oLOCDom.documentelement.selectSingleNode("//datafield[@tag='020']/subfield[@code='a']/text()").Text,
255)
End If
'Remove the trailing colon, if present
intLength = Len(rs1!ISBN)
If Right(rs1!ISBN, 1) = ":" Then
rs1!ISBN = Left(rs1!ISBN, intLength - 1)
End If
'Dewey Decimal Number: Tag field 082; Subfield $a
If Not
oLOCDom.documentelement.selectSingleNode("//datafield[@tag='082']/subfield[@code='a']/text()")
Is Nothing Then
rs1!Dewey =
Left(oLOCDom.documentelement.selectSingleNode("//datafield[@tag='082']/subfield[@code='a']/text()").Text,
255)
'Remove the backslashes, if present
rs1!Dewey = Replace(rs1!Dewey, "/", "")
'Remove alternative Dewey Decimal Number (for example "B")
If InStr(rs1!Dewey, "$") Then
rs1!Dewey = Left(rs1!Dewey, (InStr(rs1!Dewey, "$") - 1))
End If
End If
'Author: Tag field 100; Subfield $a
If Not
oLOCDom.documentelement.selectSingleNode("//datafield[@tag='100']/subfield[@code='a']/text()")
Is Nothing Then
rs1!Author1 =
Left(oLOCDom.documentelement.selectSingleNode("//datafield[@tag='100']/subfield[@code='a']/text()").Text,
255)
'Remove the trailing comma or period, if present
intLength = Len(rs1!Author1)
If Right(rs1!Author1, 1) = "," Or Right(rs1!Author1, 1) = "." Then
rs1!Author1 = Left(rs1!Author1, intLength - 1)
End If
End If
'Title: Tag Field 245; Subfield $a
If Not
oLOCDom.documentelement.selectSingleNode("//datafield[@tag='245']/subfield[@code='a']/text()")
Is Nothing Then
rs1!Title =
Left(oLOCDom.documentelement.selectSingleNode("//datafield[@tag='245']/subfield[@code='a']/text()").Text,
255)
'Remove the trailing backslash, if present
intLength = Len(rs1!Title)
If Right(rs1!Title, 1) = "/" Then
rs1!Title = Left(rs1!Title, intLength - 1)
End If
End If
'SubTitle: Tag Field 245; Subfield $b
If Not
oLOCDom.documentelement.selectSingleNode("//datafield[@tag='245']/subfield[@code='b']/text()")
Is Nothing Then
rs1!Subtitle =
Left(oLOCDom.documentelement.selectSingleNode("//datafield[@tag='245']/subfield[@code='b']/text()").Text,
255)
'Remove the trailing backslash, if present
intLength = Len(rs1!Subtitle)
If Right(rs1!Subtitle, 1) = "/" Then
rs1!Subtitle = Left(rs1!Subtitle, intLength - 1)
End If
End If
'Edition Statement: Tag Field 250, Subfield $a
If Not
oLOCDom.documentelement.selectSingleNode("//datafield[@tag='250']/subfield[@code='a']/text()")
Is Nothing Then
rs1!Edition =
Left(oLOCDom.documentelement.selectSingleNode("//datafield[@tag='250']/subfield[@code='a']/text()").Text,
255)
End If
'Place of publication: Tag Field 260; Subfield $a
If Not
oLOCDom.documentelement.selectSingleNode("//datafield[@tag='260']/subfield[@code='a']/text()")
Is Nothing Then
rs1!PubPlace =
Left(oLOCDom.documentelement.selectSingleNode("//datafield[@tag='260']/subfield[@code='a']/text()").Text,
255)
'Remove the trailing colon or comma, if present
intLength = Len(rs1!PubPlace)
If Right(rs1!PubPlace, 1) = ":" Or Right(rs1!PubPlace, 1) = "," Then
rs1!PubPlace = Left(rs1!PubPlace, intLength - 1)
End If
'Remove alternative place of publication (sometimes two or more
places are listed...)
If InStr(rs1!PubPlace, "$") Then
rs1!PubPlace = Left(rs1!PubPlace, (InStr(rs1!PubPlace, "$") -
3))
End If
End If
'Publisher: Tag Field 260: Subfield $b
If Not
oLOCDom.documentelement.selectSingleNode("//datafield[@tag='260']/subfield[@code='b']/text()")
Is Nothing Then
rs1!Publisher =
Left(oLOCDom.documentelement.selectSingleNode("//datafield[@tag='260']/subfield[@code='b']/text()").Text,
255)
'Remove the trailing comma, if present
intLength = Len(rs1!Publisher)
If Right(rs1!Publisher, 1) = "," Then
rs1!Publisher = Left(rs1!Publisher, intLength - 1)
End If
End If
'Year of publication: Tag Field 260: Subfield $c
If Not
oLOCDom.documentelement.selectSingleNode("//datafield[@tag='250']/subfield[@code='c']/text()")
Is Nothing Then
rs1!PubDate =
Left(oLOCDom.documentelement.selectSingleNode("//datafield[@tag='250']/subfield[@code='c']/text()").Text,
255)
'Remove the trailing period, and copyright "c", and square
brackets...
rs1!PubDate = Replace(rs1!PubDate, ".", "")
rs1!PubDate = Replace(rs1!PubDate, "c", "")
rs1!PubDate = Replace(rs1!PubDate, "[", "")
rs1!PubDate = Replace(rs1!PubDate, "]", "")
rs1!PubDate = Trim(rs1!PubDate)
End If
'Extent: Tag Field 300, Subfield $a
If Not
oLOCDom.documentelement.selectSingleNode("//datafield[@tag='300']/subfield[@code='a']/text()")
Is Nothing Then
rs1!Extent =
Left(oLOCDom.documentelement.selectSingleNode("//datafield[@tag='300']/subfield[@code='a']/text()").Text,
255)
'Remove the trailing colon, if present
intLength = Len(rs1!Extent)
If Right(rs1!Extent, 1) = ";" Or Right(rs1!Extent, 1) = ":" Then
rs1!Extent = Left(rs1!Extent, intLength - 1)
End If
End If
'Other physical details: Tag field 300, Subfield $b
If Not
oLOCDom.documentelement.selectSingleNode("//datafield[@tag='300']/subfield[@code='b']/text()")
Is Nothing Then
rs1!OtherDetails =
Left(oLOCDom.documentelement.selectSingleNode("//datafield[@tag='300']/subfield[@code='b']/text()").Text,
255)
'Remove the trailing colon, if present
intLength = Len(rs1!OtherDetails)
If Right(rs1!OtherDetails, 1) = ";" Or Right(rs1!OtherDetails, 1) =
":" Then
rs1!OtherDetails = Left(rs1!OtherDetails, intLength - 1)
End If
End If
'Dimensions: Tag field 300, Subfield $c
If Not
oLOCDom.documentelement.selectSingleNode("//datafield[@tag='300']/subfield[@code='c']/text()")
Is Nothing Then
rs1!Dimensions =
Left(oLOCDom.documentelement.selectSingleNode("//datafield[@tag='300']/subfield[@code='c']/text()").Text,
255)
End If
'Accompanying items: Tag field 300, Subfield $e
If Not
oLOCDom.documentelement.selectSingleNode("//datafield[@tag='300']/subfield[@code='e']/text()")
Is Nothing Then
rs1!AccompanyingItems =
Left(oLOCDom.documentelement.selectSingleNode("//datafield[@tag='300']/subfield[@code='e']/text()").Text,
255)
End If
' Series: Tag Field 490; Subfield $a
If Not
oLOCDom.documentelement.selectSingleNode("//datafield[@tag='490']/subfield[@code='a']/text()")
Is Nothing Then
rs1!Series =
Left(oLOCDom.documentelement.selectSingleNode("//datafield[@tag='490']/subfield[@code='a']/text()").Text,
255)
End If
'Notes: Tag Field 500; Subfield $a
If Not
oLOCDom.documentelement.selectSingleNode("//datafield[@tag='500']/subfield[@code='a']/text()")
Is Nothing Then
rs1!Notes =
Left(oLOCDom.documentelement.selectSingleNode("//datafield[@tag='500']/subfield[@code='a']/text()").Text,
255)
End If
'Subject Headings: Since subject headings are repeatable to accomodate
multiple subjects,
' they take a bit more processing; we need to loop through the subject
nodes....
'Up to five subject headings are accomodated in this demo, although more
are possible.
Dim oLOCDomNode As IXMLDOMNode
Dim oLOCDomNodeList As IXMLDOMNodeList
Dim oLOCDomNode2 As IXMLDOMNode
Dim oLOCDomNodeList2 As IXMLDOMNodeList
Set oLOCDomNodeList = oLOCDom.selectNodes("//datafield[@tag='650']")
lngI = -1
For Each oLOCDomNode In oLOCDomNodeList
lngI = lngI + 1
Select Case lngI
Case 0
Set oLOCDomNodeList2 =
oLOCDomNode.selectNodes("subfield")
rs1!Subject1 = ""
For Each oLOCDomNode2 In oLOCDomNodeList2
rs1!Subject1 = rs1!Subject1 & "--" &
oLOCDomNode2.Text
Next
rs1!Subject1 = Mid(rs1!Subject1, 3)
intLength = Len(rs1!Subject1)
If Right(rs1!Subject1, 1) = "." Then
rs1!Subject1 = Left(rs1!Subject1, intLength - 1)
End If
Case 1
Set oLOCDomNodeList2 =
oLOCDomNode.selectNodes("subfield")
rs1!Subject2 = ""
For Each oLOCDomNode2 In oLOCDomNodeList2
rs1!Subject2 = rs1!Subject2 & "--" &
oLOCDomNode2.Text
Next
rs1!Subject2 = Mid(rs1!Subject2, 3)
intLength = Len(rs1!Subject2)
If Right(rs1!Subject2, 1) = "." Then
rs1!Subject2 = Left(rs1!Subject2, intLength - 1)
End If
Case 2
Set oLOCDomNodeList2 =
oLOCDomNode.selectNodes("subfield")
rs1!Subject3 = ""
For Each oLOCDomNode2 In oLOCDomNodeList2
rs1!Subject3 = rs1!Subject3 & "--" &
oLOCDomNode2.Text
Next
rs1!Subject3 = Mid(rs1!Subject3, 3)
intLength = Len(rs1!Subject3)
If Right(rs1!Subject3, 1) = "." Then
rs1!Subject3 = Left(rs1!Subject3, intLength - 1)
End If
Case 3
Set oLOCDomNodeList2 =
oLOCDomNode.selectNodes("subfield")
rs1!Subject4 = ""
For Each oLOCDomNode2 In oLOCDomNodeList2
rs1!Subject4 = rs1!Subject4 & "--" &
oLOCDomNode2.Text
Next
rs1!Subject4 = Mid(rs1!Subject4, 3)
intLength = Len(rs1!Subject4)
If Right(rs1!Subject4, 1) = "." Then
rs1!Subject4 = Left(rs1!Subject4, intLength - 1)
End If
Case 4
Set oLOCDomNodeList2 =
oLOCDomNode.selectNodes("subfield")
rs1!Subject5 = ""
For Each oLOCDomNode2 In oLOCDomNodeList2
rs1!Subject5 = rs1!Subject5 & "--" &
oLOCDomNode2.Text
Next
rs1!Subject5 = Mid(rs1!Subject5, 3)
intLength = Len(rs1!Subject5)
If Right(rs1!Subject5, 1) = "." Then
rs1!Subject5 = Left(rs1!Subject5, intLength - 1)
End If
Case Else
End Select
Next
'Added Author Entries: Since books can have multiple authors, Tag Field
700 lists added author entries.
' Like repeatable subject headings, this takes a bit more processing...
'Up to four added author headings are accomodated in this demo, although
more are possible.
Set oLOCDomNodeList = oLOCDom.selectNodes("//datafield[@tag='700']")
lngI = -1
For Each oLOCDomNode In oLOCDomNodeList
lngI = lngI + 1
Select Case lngI
Case 0
Set oLOCDomNodeList2 =
oLOCDomNode.selectNodes("subfield")
rs1!Author2 = ""
For Each oLOCDomNode2 In oLOCDomNodeList2
rs1!Author2 = rs1!Author2 & "--" & oLOCDomNode2.Text
Next
rs1!Author2 = Mid(rs1!Author2, 3)
intLength = Len(rs1!Author2)
If Right(rs1!Author2, 1) = "." Then
rs1!Author2 = Left(rs1!Author2, intLength - 1)
End If
Case 1
Set oLOCDomNodeList2 =
oLOCDomNode.selectNodes("subfield")
rs1!Author3 = ""
For Each oLOCDomNode2 In oLOCDomNodeList2
rs1!Author3 = rs1!Author3 & "--" & oLOCDomNode2.Text
Next
rs1!Author3 = Mid(rs1!Author3, 3)
intLength = Len(rs1!Author3)
If Right(rs1!Author3, 1) = "." Then
rs1!Author3 = Left(rs1!Author3, intLength - 1)
End If
Case 2
Set oLOCDomNodeList2 =
oLOCDomNode.selectNodes("subfield")
rs1!Author4 = ""
For Each oLOCDomNode2 In oLOCDomNodeList2
rs1!Author4 = rs1!Author4 & "--" & oLOCDomNode2.Text
Next
rs1!Author4 = Mid(rs1!Author4, 3)
intLength = Len(rs1!Author4)
If Right(rs1!Author4, 1) = "." Then
rs1!Author4 = Left(rs1!Author4, intLength - 1)
End If
Case 3
Set oLOCDomNodeList2 =
oLOCDomNode.selectNodes("subfield")
rs1!Author5 = ""
For Each oLOCDomNode2 In oLOCDomNodeList2
rs1!Author5 = rs1!Author5 & "--" & oLOCDomNode2.Text
Next
rs1!Author5 = Mid(rs1!Author5, 3)
intLength = Len(rs1!Author5)
If Right(rs1!Author5, 1) = "." Then
rs1!Author5 = Left(rs1!Author5, intLength - 1)
End If
Case Else
End Select
Next
End If
End If
rs1.Update
rs.MoveNext
Loop
rs.Close
rs1.Close
MsgBox "All Done!"
Me.Requery
Me.Refresh
Exitpoint:
Set db = Nothing
Set rs = Nothing
Set rs1 = Nothing
Set rsattachCoverPicture = Nothing
Exit Sub
Errorhandler:
Select Case Err.Number
Case 3024
MsgBox "The image file could not be retrieved from Amazon.", vbCritical,
"Error: Amazon"
Case Else
MsgBox Err.Number, Err.Description
End Select
Resume Exitpoint
End Sub
