Application Takeover

[BBQ]

Hello everybody !

i got just started with VBA in Excel so here is my question:
how can i open a link on a page of a webbrowser in a separate tab
and copy what is inside the page to a table ?

Now the link is like this:
http://www.tonermaus.de/main_02.asp?sid={0A01180F-6099-48E5-B2FE-87B23A4CA092}&login=&nav01=8

As u can see there are lots of links on this site, my qustion is to open them all by one and copy the text to an excel table.

I got also some code alredy for beginning:

Sub Firecracker()
myUrl = "http://www.tonermaus.de/main_02.asp?sid={0A01180F-6099-48E5-B2FE-87B23A4CA092}&login=&nav01=8"

Set oIE = CreateObject("InternetExplorer.Application")
oIE.Visible = True
oIE.Navigate myUrl

While Not oIE.ReadyState = 4
DoEvents 'gives the control back to windows shedule
Wend

Set oIE = Nothing
End Sub

So that code only opens the page. Like i said before just for starting.
I hope somebody can help me out here so please let me know.
Code would be nice....

Thanks and greetings
N.

 

[Norie]

Something like this is theoretically possible but isn't very practical.

There are 291 links at that URL.

How will you determine which ones to actually follow?

Also where do you want to copy the data to?

 

[BBQ]

Further Explanation

@Norie:
Yes, exactly there are 291 links. The goal is to create an automatization process so each link is a page and its content should be copied to an excel document thats all. So in the end u have 291 entrys in the table or smth like this.

Steps are clear 2 me but i cant get it with VBA
Should be like this : Open browser page with links. Count the links on the page. Click from the first to the last while copying each page content to an excel table.

Could somebody be so kind an write me a short piece of code ?

 

[Norie]

BBQ

Here's code but like I said this sort of think is impractical.

Sub Firecracker()
Dim oIE As Object
Dim oIELink As Object
Dim lnk As Object

    myUrl = "http://www.tonermaus.de/main_02.asp?sid={0A01180F-6099-48E5-B2FE-87B23A4CA092}&login=&nav01=8"

    Set oIE = CreateObject("InternetExplorer.Application")
    oIE.Visible = True
    oIE.Navigate myUrl

    While Not oIE.ReadyState = 4: DoEvents: Wend
 
    Set doc = oIE.document

    For Each lnk In doc.links
        If lnk.InnerHTML <> "Herstellerauswahl" Then
            Set oIELink = CreateObject("InternetExplorer.Application")

            oIELink.Navigate lnk
            
            While Not oIELink.ReadyState = 4: DoEvents: Wend
            
            Set doclink = oIELink.document
            Worksheets.Add
            GetOneTable doclink, 7
            oIELink.Quit
        End If
    Next lnk
    oIE.Quit
    Set oIE = Nothing
    
End Sub

Sub GetOneTable(d, n)
' d is the document
' n is the table to extract
Dim e As Object ' the elements of the document
Dim t As Object ' the table required
Dim r As Object ' the rows of the table
Dim c As Object ' the cells of the rows.
Dim I As Long
Dim J As Long

    For Each e In d.all
        If e.nodename = "TABLE" Then
            J = J + 1
        End If
        If J = n Then
            Set t = e
    
            tabno = tabno + 1
            nextrow = nextrow + 1
            Set rng = Range("A" & nextrow)
            For Each r In t.Rows
                For Each c In r.Cells
                    rng.Value = c.innertext
                    Set rng = rng.Offset(, 1)
                    I = I + 1
                Next c
                nextrow = nextrow + 1
                Set rng = rng.Offset(1, -I)
                I = 0
            Next r
            Exit For
        End If
    
    Next e
    
End Sub

 

[BBQ]

Worksheet caption

@Norie:

Thanx for your support. This was very helpful to me as a beginner in VBA.
It helped me to understand the process with the reading out of a table and how to manage this huge blocks of data.
So if u should need something about Delphi/Pascal or Action Script of Flash let me know.

Now I admit you're right -- it is kinda impractical, but it works all the way exactly as it should. Btw i am trying to figure out how to name the sheets which being added, by the link name. So the entry would be like Epson 1300 for ex. in a sheet. Your var for the link is lnk, i think this is an IE Object.

How can i add the name of the link to the caption of the sheet ?


Thx again for the enlightment.

 

[Norie]

This perhaps:

Worksheets.Add.Name = lnk.innerText

Note this includes no error checking for valid sheet names.

EDIT: But hey guess what? All the names appear to be valid.

 

[BBQ]

Thats it. Exactly .innerText was the keyattribute. Now i can write some error handlers and without your help i would be sitting now in front of the VBA documentation for hours.

So BIG thanks to you, now it is solved.

Best regards,
BBQ

 

[BBQ]

Part 2 Sorting sheets

@Norie:

Greetings! I'am trying to take this one a little bit further,
now I wrote a makro which goes through all sheets and merges them in
one big "MergeSheet". While each Model of a printer is added like "Druckerhersteller\Epson\" + Sheetname. Code looks like this:

Sub Test1()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Delete the sheet "MergeSheet" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ThisWorkbook.Worksheets("MergeSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Add a worksheet with the name "MergeSheet"
Set DestSh = ThisWorkbook.Worksheets.Add
DestSh.Name = "MergeSheet"

'loop through all worksheets and copy the data to the DestSh
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> DestSh.Name Then
Last = LastRow(DestSh)

sh.Range("A1:G1").Copy DestSh.Cells(Last + 1, "A")
sh.UsedRange.Copy DestSh.Cells(Last + 1, "B")
DestSh.Cells(Last + 1, "A").Value = "Druckerhersteller\Epson\" + sh.Name
End If
Next

Application.Goto DestSh.Cells(1)

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function


Function LastCol(sh As Worksheet)
On Error Resume Next
LastCol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function

After your, first makro alredy pasted the sheets in the table.
So each entry in "MergeSheet" looks like this:
Druckerhersteller\Epson\TM-U 950 Artikelnummer Artikelbeschreibung

ERC-31B Farbband schwarz
for ex.

But found out its kinda messy. So i got 2 questions:

1. how do i delete all cells with a given name ? (delete all: "artikelnummer" ) ?
2.Now some of the entrys go with 3 or more article numbers ex. Messed up with empty cells.
How can i filter this merged sheet so it looks like this:

Druckerhersteller\Epson\Stylus1 ERB-123
Druckerhersteller\Epson\Stylus1 ERB-456
Druckerhersteller\Epson\Stylus1 ABC-123
Druckerhersteller\Epson\SuperP2 ADD-000
Druckerhersteller\Epson\SuperP2 AXD-020
... and so on....

Could u please help me out on this one ?
Thx again.

 

[Norie]

Not sure exactly what you mean for either of those questions.

What I would actually recommend is doing this from the 'source'.

And by that I mean write code that imports all the data into one sheet when the links are followed rather than seperate sheets.

Part of the code I posted, the sub GetATable, is only generic.

ie it just gets the table you specify.

It doesn't check for empty cells or anything else.

The main thing that needs to be done is examine the structure of these tables/pages.

So far I think we've struck it lucky that the data you seem to want is located in the same table in each page.

If you could expand on what you are ultimately trying to achieve I'll look into this further.