[VB6] Copiare dati da una pagina Web estraendoli da una colonna

[peppegiuseppe]

ci sono un sacco di stinghe strane tutte come te le ho postate....

[oregon]

Ok, ma cerca una stringa nota e vedi dove sta ...

[peppegiuseppe]

della tabella che vorrei non c'è traccia.... l'ho controllata... ora ti posto il prog e il risultato
programma
Private Sub Command1_Click()
Dim ie As Object
Set ie = CreateObject("InternetExplorer.Application")
ie.Navigate "http://txodds.com/omoves.php?ot=0"
Do Until ie.ReadyState = 4
Loop

Dim iht As String
Dim ihtx As Long
iht = ie.Document.body.innerHTML
ihtx = InStr(iht, "datemat")
If ihtx > 0 Then
ihtx = InStr(ihtx, iht, vbCrLf)
iht = Mid$(iht, ihtx)
End If

Text1.Text = iht

ie.Quit
End Sub
-----------
risultato:
<DIV id=wrapper>
<DIV class=altmenu>skip to content</DIV>
<DIV id=logindialog class="jqmWindow jqmID1" _jqm="1">
<H2>Login</H2>
<FORM method=post action=/login.php><INPUT value=1 type=hidden name=login>
<DIV class=inputs>
<DIV class=element><LABEL class=label for=ident>Username</LABEL> <INPUT class=text title=Username size=20 type=text name=ident> </DIV>
<DIV class=element><LABEL class=label for=passwd>Password</LABEL> <INPUT class=password value="" size=20 type=password name=passwd> </DIV></DIV>
<DIV class=buttons2>
<DIV class=element><SELECT name=type> <OPTION selected value=1>free/pro/alerts</OPTION> <OPTION value=8>ahc</OPTION></SELECT> </DIV>
<DIV class=element>
<DIV style="MozUserSelect: none" class=button jQuery1329852167425="13"><SPAN jQuery1329852167425="15">Login<INPUT style="DISPLAY: none" value=Login type=submit jQuery1329852167425="11"></SPAN></DIV> </DIV></DIV>
<DIV class=rememberme><LABEL class=label for=rememberme>Remember me</LABEL>
<DIV class=checker jQuery1329852167425="17"><SPAN jQuery1329852167425="19"><INPUT style="FILTER: alpha(opacity=0); ZOOM: 1" type=checkbox name=rememberme jQuery1329852167425="20"></SPAN></DIV> </DIV></FORM></DIV>
<DIV id=languagedialog class="jqmWindow jqmID2" _jqm="2">
<H2>Choose Language</H2>
<UL>
<LI>English</LI>
<LI>Chinese (simple)</LI>
<LI>Serbian</LI>
<LI>Turkish</LI>
<LI>Italian</LI>
<LI>Greek</LI>
<LI>Russian</LI>[/list]</DIV>
<UL id=topmenu>
<LI class=first>About</LI>
<LI>Contact</LI>
<LI>Help</LI>
<LI>FAQs </LI>
<LI>Twitter</LI>
<LI>Sitemap </LI>
<LI>Language</LI>
<LI class=right>Login</LI>
<LI class="first right">Register </LI>[/list]
<DIV style="BORDER-BOTTOM: medium none; POSITION: relative; BORDER-LEFT: medium none; ZOOM: 1; BORDER-TOP: medium none; BORDER-RIGHT: medium none" id=header>
<DIV style="POSITION: absolute; PADDING-BOTTOM: 0px; MARGIN: 0px; PADDING-LEFT: 0px; WIDTH: 100%; PADDING-RIGHT: 0px; TOP: 0px; RIGHT: 0px; PADDING-TOP: 0px; LEFT: 0px" class=jquery-corner>
<DIV style="BORDER-BOTTOM: #fff 0px; BORDER-LEFT: #fff 2px solid; BACKGROUND-COLOR: transparent; HEIGHT: 1px; OVERFLOW: hidden; BORDER-TOP: #fff 0px; BORDER-RIGHT: #fff 2px solid"></DIV>
<DIV style="BORDER-BOTTOM: #fff 0px; BORDER-LEFT: #fff 1px solid; BACKGROUND-COLOR: transparent; HEIGHT: 1px; OVERFLOW: hidden; BORDER-TOP: #fff 0px; BORDER-RIGHT: #fff 1px solid"></DIV>
<DIV style="BORDER-BOTTOM: #fff 0px; BORDER-LEFT: #fff 0px solid; BACKGROUND-COLOR: transparent; HEIGHT: 1px; OVERFLOW: hidden; BORDER-TOP: #fff 0px; BORDER-RIGHT: #fff 0px solid"></DIV>
<DIV style="BORDER-BOTTOM: #fff 0px; BORDER-LEFT: #fff 0px solid; BACKGROUND-COLOR: transparent; HEIGHT: 1px; OVERFLOW: hidden; BORDER-TOP: #fff 0px; BORDER-RIGHT: #fff 0px solid"></DIV>
<DIV style="BORDER-BOTTOM: #fff 0px; BORDER-LEFT: #fff 0px solid; BACKGROUND-COLOR: transparent; HEIGHT: 1px; OVERFLOW: hidden; BORDER-TOP: #fff 0px; BORDER-RIGHT: #fff 0px solid"></DIV></DIV>
<H1 class=logo></H1>
<DIV id=utils>
<FORM id=searchform method=post name=qsearch action=/quick_search.php><INPUT id=searchstring class="searchinput toggleval" title="search team/player.." value="search team/player.." type=text name=qsstring jQuery1329852167425="23"> <INPUT class=gobutton value=Go type=submit> </FORM>
<DIV id=addthis_button>
<SCRIPT type=text/javascript src="http://s7.addthis.com/js/250/addthis_widget.js#username=xa-4d5a5fd570a8da9f&amp;async=1"></SCRIPT>
</DIV></DIV>
<DIV id=topbanner>
<SCRIPT type=text/javascript><!--//<![CDATA[
var m3_u = (location.protocol=='https:'?'https://adserv.tip-ex.com/delivery/ajs.php':'http://adserv.tip-ex.com/delivery/ajs.php');
var m3_r = Math.floor(Math.random()*99999999999);
if (!document.MAX_used) document.MAX_used = ',';
document.write ("<scr"+"ipt type='text/javascript' src='"+m3_u);
document.write ("?zoneid=1&amp;target=_top");
document.write ('&amp;cb=' + m3_r);
if (document.MAX_used != ',') document.write ("&amp;exclude=" + document.MAX_used);
document.write (document.charset ? '&amp;charset='+document.charset : (document.characterSet ? '&amp;charset='+document.characterSet : ''));
document.write ("&amp;loc=" + escape(window.location));
if (document.referrer) document.write ("&amp;referer=" + escape(document.referrer));
if (document.context) document.write ("&context=" + escape(document.context));
if (document.mmm_fo) document.write ("&amp;mmm_fo=1"






e poi va avanti in questo modo.....

[oregon]

C'è ... ma forse è meglio cambiare strategia, dato che la pagina è complessa.

Utilizza la libreria HTML ... aggiungi il Riferimento alla libreria "Microsoft HTML ..." e parti da questo esempio di codice

    Dim objMSHTML As New MSHTML.HTMLDocument
    Dim objDoc As MSHTML.HTMLDocument
    Dim oTab As MSHTML.HTMLTable
    Dim oTabRow As MSHTML.HTMLTableRow
    Dim oTabEl As MSHTML.IHTMLElement
    
    Set objDoc = objMSHTML.createDocumentFromUrl("http://txodds.com/omoves.php?ot=0", vbNullString)

    Do While objDoc.readyState <> "complete"
        DoEvents
    Loop

    Set oTab = objDoc.All.tags("table").Item(0)
    
    Dim h As String
    Dim i As Integer
    Dim j As Integer
    
    For i = 2 To 4 ' Numero riga partita ... modifica
        Set oTabRow = oTab.rows.Item(i)
        For j = 0 To 18
            Set oTabEl = oTabRow.cells.Item(j)
            h = oTabEl.innerText
            MsgBox h
        Next j
    Next i

[peppegiuseppe]

bene! molto bene!
invece che mettere i valori in un msgbox come posso metterli in una textbox?
ho provato facendo

text1.text = h

ma mi restituisce solo un valore, che tra l'altro non è neanche il primo

[oregon]

Originariamente inviato da peppegiuseppe
invece che mettere i valori in un msgbox come posso metterli in una textbox?

Eh ... va beh ... allora faccio io il programma e quando è pronto ti faccio un fischio.

Scusa, ma parliamo di roba elementare ... un po' di impegno non guasta!

[peppegiuseppe]

niente non ci riesco....

mi spiegheresti gentilmente perche questa parte di codice non mi riporta quello che vorrei, ma solo la prima cella?

For i = 2 To 3 ' Numero riga partita ... modifica
 Set oTabRow = oTab.rows.Item(i) 
For j = 0 To 18 
Set oTabEl = oTabRow.cells.Item(j)
h = oTabEl.innerText 
textbox1.Text = h 
Next j 
Next i 
End Sub

[peppegiuseppe]

ho provato a fare questo ma farlo per 1000 celle diventa lunghissimo e faticoso
p.s ho messo i valori in un file excel...

Private Sub Command1_Click()

    Dim objMSHTML As New MSHTML.HTMLDocument
    Dim objDoc As MSHTML.HTMLDocument
    Dim oTab As MSHTML.HTMLTable
    Dim oTabRow As MSHTML.HTMLTableRow
    Dim oTabEl As MSHTML.IHTMLElement
    Dim ex As Excel.Application
    Dim wb As Workbook
    Dim ws As Worksheet
    
    Set objDoc = objMSHTML.createDocumentFromUrl("http://txodds.com/omoves.php?ot=0", vbNullString)

    Do While objDoc.readyState <> "complete"
        DoEvents
    Loop

    Set oTab = objDoc.All.tags("table").Item(0)
    
    Dim h As String
    Dim i As Integer
    Dim j As Integer
    Set ex = New Excel.Application
    
    Set ws = wb.Sheets.Item("Avanti")
        Set oTabRow = oTab.rows.Item(2)
        Set oTabEl = oTabRow.cells.Item(0)
        h = oTabEl.innerText
        ws.range("A1:A1") = h
        Set oTabRow = oTab.rows.Item(2)
        Set oTabEl = oTabRow.cells.Item(1)
        h = oTabEl.innerText
        ws.range("B1:B1") = h
            
    wb.Save
    End Sub
    Private Sub btnChiudi_Click()
    Dim wb As Workbook
    Set wb = ex.Workbooks.Open("C:\Users\peppe\desktop\Avanti.xlsx", , 0)
    wb.Close
    Set wb = Nothing
    ex.Quit
End Sub