[Excel07] Πως κατεβάζω σελίδα;

[georgiosdrim]

Καλημέρα και Χρόνια Πολλά σε όλους,
Θα ηθελα να με βοηθησετε να μπορεσω να κανω το εξης:
Δεν μπορω να κατεβασω απο ενα url τον κεντρικο πινακα που βλεπω μιας και στην εισαγωγη που κανω απο εξωτερικα δεδομενα παιρνω το μηνυμα οτι το ερωτημα στο web δεν επεστρεψε δεδομενα..
Ειμαι νεος και δεν μου επιτρεπει ακομα το φορουμ να βαλω το url Αν υπαρχει καποιο πρωτο βημα καθοδηγησης?

[gr8styl]

Καλησπέρα και καλώς όρισες.

Γράψε μας την διεύθυνση χωρίς να επιλέξεις εισαγωγή URL και αφαιρώντας το http://

[georgiosdrim]

1x2.7m.hk/result_en.shtml?dt=2012-07-09&cid=254

Απο αυτη την σελιδα θελω τον κεντρικο πινακα και αν ειναι δυνατον να κατεβαζω πολλες ημερομηνιες παλιες

[Tasos]

Καλημέρα και καλώς όρισες.

Ορισμένες ιστοσελίδες για δικούς τους λόγους (τεχνικούς ή μη) δεν μπορούν να περιέχουν δεδομένα
που είναι προσβάσιμα από προγράμματα όπως η Excel.

Εφόσον όμως τα δεδομένα αυτά καταλήγουν στον υπολογιστή, υπάρχει πάντα κάποιος τρόπος (αναλόγως την ιστοσελίδα) που επιτρέπει την εισαγωγή τους στην Excel.

To παράδειγμα στο συνημμένο περιέχει κώδικα VBA που ανοίγει σε μη ορατό Internet Explorer την επιθυμητή ιστοσελίδα, αντιγράφει τα δεδομένα σε αρχείο *.html που δημιουργεί στον ίδιο φάκελο και εισάγει τα δεδομένα αυτά με την κλασσική μέθοδο εισαγωγής δεδομένων από το Web.

Θα πρέπει να ενεργοποιηθούν οι μακροεντολές για να λειτουργήσει.

Χρειάζεται να γνωρίζει κανείς τουλάχιστον τα κλασικά προγραμματισμού σε Excel, HTML, VBA αλλά και του αντικειμένου Internet Explorer για να προσαρμόσει το παράδειγμα στα μέτρα του.

Καλή συνέχεια!

Τάσος

[georgiosdrim]

Σ ευχαριστω για το χρονο που διεθεσες να με βοηθησεις ωστόσο όσες προσπαθειες και αν εκανα το μηνυμα που παιρνω ειναι να "ελενξω την συνδεση του ιντερνετ" και ετσι δεν μπορεσα να δω αν κατεβαζει και πως...

[Tasos]

Καλησπέρα!

Το πρόβλημα δεν βρίσκεται στο αρχείο αλλά στους Dns του συγκεκριμένου Server.

Άλλαξα το συνημμένο με ένα νέο. Η μόνη τεχνική διαφορά που βελτιώνει λίγο την κατάσταση είναι ότι προστέθηκαν αναφορές στο έργο VBA προκειμένου να βελτιωθεί η απόκριση αλλά και η απόδοση του παραδείγματος.

Μπορείς να δοκιμάσεις το νέο συνημμένο. Σε μένα λειτουργεί κανονικά αλλά όπως είπα δεν μπορούμε να επηρεάσουμε βασικούς παράγοντες όπως είναι η ταχύτητα και η απόκριση του Server.

Τάσος

[georgiosdrim]

Ωραια χτυπαει τωρα και η ταχυτητα του ειναι παρα πολυ καλη ...Μονο απαραιτητο είναι στο url που βαζουμε στον κωδικα ειναι να υπαρχει και το cid=254 για να παιρνει απο συγκεκριμενη εταιρια και οχι τον μεσο ορο που ειναι απαραιτητο για να γινει η δουλεια μας........

1x2.7m.hk/result_en.shtml?dt=2012-07-09&cid=254

[Tasos]

Στο συγκεκριμένο αρχείο κάνε κλικ σε ένα κελί και πάτησε ALT + F11
Στο παράθυρο που θα εμφανιστεί, αντικατέστησε όλο τον κώδικα που υπάρχει στη λειτουργική μονάδα "Module1" με τον παρακάτω:

Option Explicit

Sub GetWebData()
    Dim ie As InternetExplorer
    Dim oBody As HTMLBody
    Dim oTable As HTMLTable
    Dim TableCol As IHTMLElementCollection
    Dim strFilePath As String
    Dim fso As Scripting.FileSystemObject
    Dim oStream As Scripting.TextStream
    Dim strDate As String
    Dim ieResponseTimeout As Date
    Dim ProgRange As Range
    Dim TablehasData As Boolean
    Dim tblCount As Integer
    Set ProgRange = Range("progress")
    If IsDate(ShWebImport.Range("C1").Value) Then
        strDate = Format(ShWebImport.Range("C1").Value, "yyyy-MM-dd")
    Else
        ShWebImport.Activate
        Range("C1").Select
        ActiveWindow.ScrollRow = 1
        ProgRange = "Συμπλήρωσε ημερομηνία στο παραπάνω κελί"
        Exit Sub
    End If
    strFilePath = ThisWorkbook.Path & "\htm.html"
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ie = CreateObject("InternetExplorer.Application")
    ie.RegisterAsBrowser = True
    '     ie.Visible = True
    ieResponseTimeout = Now + TimeSerial(0, 0, 20)
    On Error GoTo Exithere

    ProgRange = "Εισαγωγή δεδομένων από το web..."
    ie.Navigate2 "http://1x2.7m.hk/result_en.shtml?dt=" & strDate & "&cid=254"
     While ie.readyState <> READYSTATE_COMPLETE Or ie.Busy
        DoEvents
        If Now > ieResponseTimeout Then
            ProgRange = "Δεν είναι δυνατή η σύνδεση με την ιστοσελίδα."
            GoTo Exithere
        End If
    Wend
    If ie.document.URL Like "res://*" Then GoTo Exithere
    Set oBody = ie.document.body
    Set TableCol = oBody.getElementsByTagName("table")
    tblCount = TableCol.Length
    If tblCount Then
        ProgRange = "Επεξεργάζομαι δεδομένα..."
        For Each oTable In TableCol
            DoEvents
            If oTable.className = "t1" And oTable.Width = "598" Then
                ProgRange = "Δημιουργία τοπικού αρχείου *.html..."
                Set oStream = fso.CreateTextFile(strFilePath, True, True)
                oStream.write "<table>" & oTable.innerHTML & "</table>"
                oStream.Close
                TablehasData = True
                Exit For
            End If
        Next

    End If
Exithere:
    On Error Resume Next
    If Not ie Is Nothing Then
        ie.ExecWB OLECMDID_CLOSE, OLECMDEXECOPT_DONTPROMPTUSER, 0, 0
        Set ie = Nothing
        If Err <> 0 Then
            ProgRange = "Σφάλμα " & Err & " : " & Err.Description
            Exit Sub
        End If
    End If
    If TablehasData Then
        If ShWebImport.QueryTables.Count Then
            With ShWebImport.QueryTables(1)
                .Connection = "URL;file:///" & Replace(strFilePath, "\", "/")
                .Refresh BackgroundQuery:=False
                ProgRange = "Έγινε!"
            End With
        End If
    Else
        If tblCount Then
            ProgRange = "Δεν υπάρχουν δεδομένα για αυτή την ημερομηνία."
        Else
            ProgRange = "Δεν είναι δυνατη ησύνδεση με την ιστοσελίδα."
        End If
    End If
    If Err <> 0 Then
        ProgRange = "Error " & Err & " : " & Err.Description
    End If
End Sub

Αν δεν μπορείς να δεις τον αρχικό κώδικα, κάνε διπλό κλικ στη λειτουργική μονάδα "Module1" για να τον εμφανίσεις.

Καλή συνέχεια!

Τάσος