Book library

I have plenty of books, both digital and physical. The problem is with the the digital ones. They come from several sources, but as a lot they are, I can hardly know where all are stored, or if I’m in the need of some specific topic, even get to them (I use to name by ISBN, not very helpful in this point).

A library will be an excelent solution. But I have to code that library, and even get the descriptions, the cover images,… want it on Excel format, and in HTML.

Following is the main procedure to create HTML files with release info, and a description for them, with link to some web store (Amazon I suppose, to get more information and even get them on physical form). If possible I would also link to the source where they came from (with a basic cyphering code, just to not expose sensible content).

Option Explicit

Private Type tLibraryItem
    Title As String
    Date As Date
    Image As String
    Info As String
    ISBN As String
    Pages As Long
    Size As Long
    Format_ As String
    Link() As String
End Type

Private Sub sIndexGenerator()
' Given an index, generate HTML
    Dim strURL As String
    Dim strPath As String
    Dim iFile As Integer
    Dim strFile As String
    Dim strDoc As String
    
    Dim bRaw As Boolean
    Dim s As String
    Dim strHTML As String
    Dim hDoc As MSHTML.HTMLDocument
    Dim hHead As MSHTML.HTMLHeadElement
    Dim hBody As MSHTML.HTMLBody
    Dim hCollection As MSHTML.IHTMLElementCollection
    Dim hElementItem As MSHTML.IHTMLElement
    Dim hElement As MSHTML.IHTMLElement
    Dim hChildrenElement As MSHTML.IHTMLElement
    Dim hChildrenCollection As MSHTML.IHTMLElementCollection 'Object
    Dim hNode As MSHTML.IHTMLDOMNode

    Dim lgItem As Long
    Dim iFileOut As Integer
    Dim lgItemStart As Long:    lgItemStart = 1
    Dim lgItemEnd As Long:      lgItemEnd = 1
    Dim lgItemsPerPage As Long: lgItemsPerPage = 20
    Dim lgLink As Long

    Dim lC_X As Long:       lC_X = 1
    Dim lC_Title As Long:   lC_Title = lC_X + 1
    Dim lC_Link As Long:    lC_Link = lC_Title + 1
    Dim lC_PC As Long:      lC_PC = lC_Link + 1
    Dim lC_Amazon As Long:  lC_Amazon = lC_PC + 1
    Dim lC_Cat As Long:     lC_Cat = lC_Amazon + 1
    Dim lC_Image As Long:   lC_Image = lC_Cat + 1
    Dim lC_Info As Long:    lC_Info = lC_Image + 1
    Dim lC_ISBN As Long:    lC_ISBN = lC_Info + 1
    Dim lC_Size As Long:    lC_Size = lC_ISBN + 1
    Dim lC_Description As Long: lC_Description = lC_Size + 1
    Dim lC_Hosted As Long:  lC_Hosted = lC_Description + 1
    Dim lr As Long
    Dim lR_Start As Long
    Dim lR_End As Long
    
    Dim oItem() As tLibraryItem
    
    strPath = VBA.Environ$("UserProfile") & "\Documents\"
    For lgItem = 1 To 1 Step lgItemsPerPage
        iFileOut = VBA.FreeFile()
        'strFile = "test" & ".html"
        'Open strPath & "Page_" & VBA.Format(lgItem, "000") & ".html" For Output Shared As #iFileOut
        
        If bRaw Then

' Here was code to generate raw HTML, but the beautifier in wp, kills it!!
        
        Else
            ' Set hDOMDoc = oIE.Document.DOMDocument
            Set hDoc = New MSHTML.HTMLDocument
            Set hHead = hDoc.head 'or: hDoc.createElement("head")
            Set hBody = hDoc.body 'or: hDoc.createElement("body")
            
            ' Create title
            hDoc.Title = "Test"
        
            ' Create meta tags
            Set hElement = hDoc.createElement("xxx.com"">")
            hHead.appendChild hElement
            Set hElement = hDoc.createElement("")
            hHead.appendChild hElement
            Set hElement = hDoc.createElement("")
            hHead.appendChild hElement
            
            ' Link to icon
            Set hElement = hDoc.createElement("")
            hHead.appendChild hElement
            
            ' Link to CSS styles definition
            Set hElement = hDoc.createElement("")
            hHead.appendChild hElement
            
            ' Link to script code
            Set hElement = hDoc.createElement("")
            hHead.appendChild hElement
            
            '----------------------------
            ' Beautify...
            Set hElement = hDoc.createElement("div")
            hElement.setAttribute "id", "ActiveItem"
            hElement.setAttribute "class", "item"
            hBody.appendChild hElementItem

            ' Title
            Set hChildrenElement = hDoc.createElement("div")
            hChildrenElement.setAttribute "class", "title"
            hDoc.getElementById("ActiveItem").appendChild hChildrenElement
            Set hElement = hChildrenElement
            
                Set hChildrenElement = hDoc.createElement("h2")
                hElement.appendChild hChildrenElement
                Set hElement = hChildrenElement
                
                    Set hChildrenElement = hDoc.createElement("b")
                    hChildrenElement.innerText = 1 ' oItem(lgItem).Title
                    hElement.appendChild hChildrenElement
            
            Set hChildrenElement = hDoc.createElement("br"): hElementItem.appendChild hChildrenElement
            
            ' DateUpload
            Set hChildrenElement = hDoc.createElement("div")
            hChildrenElement.setAttribute "class", "date_upload"
            hChildrenElement.innerText = 1 ' oItem(lgItem).Date
            hDoc.getElementById("ActiveItem").appendChild hChildrenElement
            
            Set hChildrenElement = hDoc.createElement("br"): hElementItem.appendChild hChildrenElement
            
            ' Image
            Set hChildrenElement = hDoc.createElement("div")
            hChildrenElement.setAttribute "class", "image"
            hChildrenElement.innerText = 1 ' oItem(lgItem).Image
            hDoc.getElementById("ActiveItem").appendChild hChildrenElement
            
            Set hChildrenElement = hDoc.createElement("br"): hElementItem.appendChild hChildrenElement
            
            ' Release-info
            Set hChildrenElement = hDoc.createElement("div")
            hChildrenElement.setAttribute "class", "release_info"
            hDoc.getElementById("ActiveItem").appendChild hChildrenElement
            Set hElement = hChildrenElement
                Set hChildrenElement = hDoc.createElement("div")
                hChildrenElement.setAttribute "class", "year"
                hChildrenElement.innerText = 1 ' oItem(lgItem).Image
                hElement.appendChild hChildrenElement
            
                Set hChildrenElement = hDoc.createElement("div")
                hChildrenElement.setAttribute "class", "isbn"
                hChildrenElement.innerText = 1 ' oItem(lgItem).Image
                hElement.appendChild hChildrenElement
            
                Set hChildrenElement = hDoc.createElement("div")
                hChildrenElement.setAttribute "class", "pages"
                hChildrenElement.innerText = 1 ' oItem(lgItem).Image
                hElement.appendChild hChildrenElement
            
                Set hChildrenElement = hDoc.createElement("div")
                hChildrenElement.setAttribute "class", "size"
                hChildrenElement.innerText = 1 ' oItem(lgItem).Image
                hElement.appendChild hChildrenElement
            
                Set hChildrenElement = hDoc.createElement("div")
                hChildrenElement.setAttribute "class", "format"
                hChildrenElement.innerText = 1 ' oItem(lgItem).Image
                hElement.appendChild hChildrenElement
            
                Set hChildrenElement = hDoc.createElement("div")
                hChildrenElement.setAttribute "class", "other"
                hChildrenElement.innerText = 1 ' oItem(lgItem).Image
                hElement.appendChild hChildrenElement
            
            ' More block...
            'Set hChildrenElement = hDoc.createElement("more")
            'hChildrenElement.setAttribute "class", "???"
            'hElementItem.appendChild hChildrenElement
            'Set hElement = hChildrenElement
            
            ' Description
            'Set hElement = hDoc.createElement("div")
            hElement.setAttribute "class", "text_description"
            hElement.innerText = oItem(lgItem).Description
            hBody.appendChild hElement
            
            ' Links

' Password any?

            Set hElement = hDoc.createElement("div"): hElement.setAttribute "id", "ActiveUL"
            hElement.setAttribute "class", "download_links"
            hDoc.getElementById("ActiveItem").appendChild hElement
            
            Set hElement = hDoc.createElement("ul"): hElement.setAttribute "id", "ActiveUL"
            hDoc.getElementById("ActiveItem").appendChild hElement
            'For lgLink = 1 to 1
                Set hChildrenElement = hDoc.createElement("li")                 ' Create a node
                Set hElement = hChildrenElement
                Set hChildrenElement = hDoc.createElement("a")
                hChildrenElement.setAttribute "class", "download-btn"
                hChildrenElement.setAttribute "target", "_blank"
                hChildrenElement.setAttribute "href", oItem(lgItem).Link(lgLink)
                hChildrenElement.innerText = "Download"
                hElement.appendChild hChildrenElement
                'Set hNode = hDoc.createTextNode("TEXT")    ' Create a text node
                '.AppendChildNode

                hDoc.getElementById("ActiveUL").appendChild hElement
                hDoc.getElementById("ActiveUL").appendChild hDoc.createElement("br")
            'Next lgLink
            'Set hElement = hDoc.getElementById("ActiveUL")
            hDoc.getElementById("ActiveUL").removeAttribute ("id")

            hDoc.getElementById("ActiveItem").removeAttribute ("id")
        End If

        ' If we want to deploy the index local/web, maybe try worth considering the following code:
        'Set hCollection = hDoc.getElementsByTagName("img")
        'If hCollection.Length = 0 Then Stop
        'For Each hElement In hCollection
        '    strSrc = hElement.getAttribute("src")
        '    'hElement.removeAttribute ("src")
        '
        '    strSrc = VBA.Replace(strSrc, "\", "/") 'from local to Web
        '    strSrc = VBA.Replace(strSrc, "/", "\") 'from Web to local
        '
        '    If strSrc <> vbNullString Then
        '        hElement.setAttribute "src", strSrc
        '    End If
        '
        '    On Error Resume Next
        '    strSrc = ""
        'Next hElement
        '
        'Set hCollection = hDoc.getElementsByTagName("a")
        'If hCollection.Length = 0 Then Stop
        'For Each hElement In hCollection
        '    strSrc = hElement.getAttribute("href")
        '    strSrc = VBA.Mid$(strSrc, 1, VBA.InStr(1, strSrc, "&name", vbTextCompare) - 1)
        '
        '    If VBA.InStr(1, strSrc, "#") > 0 Then
        '        strBookmark = VBA.Mid$(strSrc, VBA.InStr(1, strSrc, "#"))
        '        strSrc = VBA.Mid$(strSrc, 1, VBA.Len(strSrc) - VBA.Len(strBookmark))
        '    End If
        '
        '    strSrc = VBA.Replace(strSrc, "\", "/") 'from local to Web
        '    strSrc = VBA.Replace(strSrc, "/", "\") 'from Web to local
        '    On Error GoTo 0
        'Next hElement

        'Print #iFileOut, hDoc.DocumentElement.innerHTML
        'Close #iFileOut

    Next lgItem

Stop

ExitProc:
    Set hElement = Nothing
    Set hElementItem = Nothing
    Set hChildrenElement = Nothing
    Set hDoc = Nothing
    'Call fIE_Terminate
    Exit Sub

ErrControl:
    'Handle Error
    Resume ExitProc
End Sub

And there should come here some downloader code, but I suspect wp will kill also, as it’s full with < and > symbols

Leave a Reply

Your email address will not be published. Required fields are marked *