Application Takeover

BBQ

New Member
Joined
Aug 22, 2007
Messages
9
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.
 

Some videos you may like

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
76,264
Office Version
  1. 365
Platform
  1. Windows
Something like this is theoretically possible but isn't very practical.

There are 291 links at that URL.:eek:

How will you determine which ones to actually follow?

Also where do you want to copy the data to?
 

BBQ

New Member
Joined
Aug 22, 2007
Messages
9
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

Well-known Member
Joined
Apr 28, 2004
Messages
76,264
Office Version
  1. 365
Platform
  1. Windows
BBQ

Here's code but like I said this sort of think is impractical.
Code:
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

New Member
Joined
Aug 22, 2007
Messages
9

ADVERTISEMENT

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

Well-known Member
Joined
Apr 28, 2004
Messages
76,264
Office Version
  1. 365
Platform
  1. Windows
This perhaps:
Code:
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

New Member
Joined
Aug 22, 2007
Messages
9

ADVERTISEMENT

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

New Member
Joined
Aug 22, 2007
Messages
9
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

Well-known Member
Joined
Apr 28, 2004
Messages
76,264
Office Version
  1. 365
Platform
  1. Windows
Not sure exactly what you mean for either of those questions.:eek:

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.:)
 

Similar threads

Watch MrExcel Video

Forum statistics

Threads
1,127,199
Messages
5,623,326
Members
415,967
Latest member
sarathbsbu12

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top