VBA打印以访问表

时间:2017-08-17 09:45:27

标签: vba ms-access access-vba

我正在构建一个库数据库,我有一个工作脚本来使用ISBN号探测Web数据库并返回有关该书的数据。我已成功使用debug.print将数据打印到即时窗口,然后使用对象的特定属性。我现在想要将直接检索到的数据打印到数据库中。

这是我的ISBN搜索代码:

Option Compare Database
    Dim BookTitle As String
    Dim BookTitleLong As String
    Dim BookAuthorsText As String
    Dim BookPublisherText As String
    Dim BookSummary As String
    Dim BookNotes As String
    Dim accessKey As String

Private Sub Class_Initialize()
    'Your isbnDB access key'
    accessKey = "xxxxxx" 'Working access key here
End Sub
Property Get Title() As String
    Title = BookTitle
End Property
Property Get TitleLong() As String
    TitleLong = BookTitleLong
End Property
Property Get AuthorsText() As String
    AuthorsText = BookAuthorsText
End Property
Property Get PublisherText() As String
    PublisherText = BookPublisherText
End Property
Property Get Summary() As String
    Summary = BookSummary
End Property
Property Get Notes() As String
    Notes = BookNotes
End Property

Public Function Lookup(ISBN As String) As Boolean
    Lookup = False
    Dim xmlhttp
    Set xmlhttp = CreateObject("MSXML2.xmlhttp")
    xmlhttp.Open "GET", "https://isbndb.com/api/books.xml?access_key=" & accessKey & "&results=texts&index1=isbn&value1=" & ISBN, False
    xmlhttp.send
    'Debug.Print "Response: " & xmlhttp.responseXML.XML'
    Dim xmldoc
    Set xmldoc = CreateObject("Microsoft.XMLDOM")
    xmldoc.async = False
    'Note: the ResponseXml property parses the server's response, responsetext doesn't
    xmldoc.loadXML (xmlhttp.responseXML.XML)
    If (xmldoc.selectSingleNode("//BookList").getAttribute("total_results") = 0) Then
        MsgBox "Invalid ISBN or not in database"
        Exit Function
    End If
    If (xmldoc.selectSingleNode("//BookList").getAttribute("total_results") > 1) Then
        MsgBox "Caution, got more than one result!"
        Exit Function
    End If
    BookTitle = xmldoc.selectSingleNode("//BookData/Title").Text
    BookTitleLong = xmldoc.selectSingleNode("//BookData/TitleLong").Text
    BookAuthorsText = xmldoc.selectSingleNode("//BookData/AuthorsText").Text
    BookPublisherText = xmldoc.selectSingleNode("//BookData/PublisherText").Text
    BookNotes = xmldoc.selectSingleNode("//BookData/Notes").Text
    BookSummary = xmldoc.selectSingleNode("//BookData/Summary").Text
    Lookup = True
End Function

这是我用来打印到即时窗口的代码

Public Function t()
    Dim book
    Set book = New ISBN
    book.Lookup ("0007102968")
    Debug.Print book.Title
    Debug.Print book.PublisherText
    Debug.Print book.AuthorsText
    Debug.Print book.TitleLong
    Debug.Print book.Summary
    Debug.Print book.Notes

End Function
这是几年前提出的这个问题的基础: ISBN -> bookdata Lookup to fill in a database

如果有人可以提供帮助,我还希望能够通过表格输入ISBN:)

1 个答案:

答案 0 :(得分:1)

您可以尝试以下方法。

首先,创建用户定义的数据type来存储图书数据:

Public Type Book
    ISBN As String
    Title As String
    TitleLong As String
    AuthorsText As String
    PublisherText As String
    Summary As String
    Notes As String
End Type

然后创建一个插入查询并将书值作为参数传递。我们将查询命名为 qryAdd

PARAMETERS prmISBN Text (255), 
           prmTitle Text (255), 
           prmPublisherText Text (255), 
           prmAuthorsText Text (255), 
           prmTitleLong Text (255), 
           prmSummary LongText, 
           prmNotes LongText;

INSERT INTO T ( ISBN, Title, PublisherText, AuthorsText, TitleLong, Summary, Notes )
SELECT prmISBN AS ISBN, 
       prmTitle AS Title, 
       prmPublisherText AS PublisherText, 
       prmAuthorsText AS AuthorsText, 
       prmTitleLong AS TitleLong, 
       prmSummary AS Summary, 
       prmNotes AS Notes;

'Change T to the name of your table and update the field names.

最后,调用插入查询的函数,我们传递要插入的书。

Public Function InsertToDatabase(b As Book) As Boolean
    With CurrentDb().QueryDefs("qryAdd")
        .Parameters("[prmISBN]").Value = b.ISBN
        .Parameters("[prmTitle]").Value = b.Title
        .Parameters("[prmTitleLong]").Value = b.TitleLong
        .Parameters("[prmPublisherText]").Value = b.PublisherText
        .Parameters("[prmAuthorsText]").Value = b.AuthorsText
        .Parameters("[prmSummary]").Value = b.Summary
        .Parameters("[prmNotes]").Value = b.Notes
        .Execute dbFailOnError
    End With

    'all good
    InsertToDatabase = True
End Function

测试它:

Sub Test()
    Dim b As Book
        b.ISBN = "aaa"
        b.Title = "bbb"
        b.TitleLong = "ccc"
        b.PublisherText = "ddd"
        b.AuthorsText = "eee"
        b.Summary = "fff"
        b.Notes = "ggg"

    If InsertToDatabase(b) Then MsgBox "Done!"
End Sub