MS Forms 2.0 library Macro

**bertlogdi1** · 06-14-2011, 06:39 AM

I seek a macro that can hold 7 pieces of manually copied data (from a website) in clipboard for inserion at 7 specific points in an excel worksheet (It will actually paste the first and then add the other 6 at specific points to lengthen the table first pasted). As clipboard normally holds only one data per time, it is said that the way to do this is to use the Data.Object in MS Forms 2.0 library. I am new to all these and therefore need your help. Thanks in advance.

**snb** · 06-14-2011, 06:45 AM

Did you ever explore a webquery ?

**bertlogdi1** · 06-14-2011, 10:51 AM

Frankly, I do not know how to do web query. However, others on the web have said that it is not possible to do so given that the data is mainly delivered by java script and the site is made in AJAX (whatever that means). I hope they are wrong and will gladly accept any help in that direction.

Originally Posted by snb

Did you ever explore a webquery ?

**Whizbang** · 06-15-2011, 10:29 AM

Here is the URL he is trying to copy/query:
http://www.racingpost.com/greyhounds/card.sd

See this thread for more information (note that the linked thread was originally about cleaning up an existing macro, whereas the OP is now requesting, if possible, to replace the current method of manually copying the tables and the running a cleanup macro with a macro that draws the data directly from the webpage to eliminate the need for a cleanup macro):
http://www.excelforum.com/excel-prog...-outputes.html

I really don't know anything about Data.Object in MS Forms 2.0 library and so recommended he start a new thread in the hopes of attracting a more knowledgable forum member.

**bertlogdi1** · 06-15-2011, 02:34 PM

Thanks Whizbang...you trully understand my position. Could not have explained any better. Thanks.

**bertlogdi1** · 06-15-2011, 02:41 PM

While roaming the internet for inspiration about this problem of getting data from racingpost, I came across this code which gets some information from that website. While it is not exactly for greyhounds, I think it might inspire someone who understands codes, to help me. Thanks in advance.

Option Explicit
 
Sub RaceMeetingCard()
Dim IE As Object
Dim doc As Object
Dim divRaces
Dim divsCol As Object
Dim divCard As Object
Dim elmt As Object
Dim lnk As Object
Dim strURL As String
Dim ws As Worksheet
Dim rng As Range

    strURL = "http://www.racingpost.com/horses2/cards/home.sd"
 
    ' Bath 11 June 2011
    'strURL = "http://www.racingpost.com/horses2/ca...ate=2011-06-11"
 
    Set IE = CreateObject("InternetExplorer.Application")

    With IE
        .navigate strURL

        Do While .Busy: DoEvents: Loop
        Do While .ReadyState <> 4: DoEvents: Loop

        '.Visible = True - this is optional
 
        Set doc = IE.Document
 
        Set divRaces = doc.getElementById("races_result")
 
        Set divsCol = divRaces.getelementsbytagname("DIV")
 
        For Each divCard In divsCol
 
            If divCard.CLASSNAME = "crBlock" Then   
 '
                Set ws = Worksheets.Add(After:=Worksheets(Worksheets.Count))
 
                Set rng = ws.Range("A1")
 
                For Each elmt In divCard.all

                    Select Case elmt.tagname

                        Case "TABLE"
                            Select Case elmt.CLASSNAME

                                Case "raceHead"
                                    rng.Value = elmt.innerText
                                    'ws.Name = rng.Value
                                    Set lnk = elmt.getelementsbytagname("A")(0)
                                    rng.Offset(2).Value = lnk
                                    Set rng = rng.Offset(6)
 
                                Case "cardsGrid"
                                    GetTableData elmt, rng
                                    Set rng = rng.Offset(elmt.Rows.Length + 1)
 
                            End Select
 
                        Case "P"

                            Select Case elmt.CLASSNAME

                                Case "border"
                                    rng.Value = elmt.innerText
                                    Set rng = rng.Offset(1)

                                Case "bull show"
                                    Set lnk = elmt.getelementsbytagname("A")(0)
                                    ws.Range("A5").Value = lnk
 
                            End Select

                    End Select
 
                Next elmt
            End If
 
            ws.Cells.WrapText = False
            ws.Range("B1:D1").EntireColumn.AutoFit

        Next divCard
 
        IE.Quit
 
        Set IE = Nothing
 
    End With
 
    Application.Goto Worksheets(1).Range("A1"), scroll
 
End Sub


'Sub to get data from a table.

Sub GetTableData(ByRef tbl, rng As Range)
Dim cl As Object
Dim rw As Object
Dim I As Long

    For Each rw In tbl.Rows
 
        For Each cl In rw.Cells

            rng.Value = cl.outerText

            Set rng = rng.Offset(, 1)

        Next cl

        Set rng = Cells(rng.Row + 1, 1)

    Next rw

End Sub