Recuperation Page Internet

Messieurs

Comment récuperer les données d'une page Internet donc html ?

a/ Ouverture URL sous Excel par ShellExecute (et son code associé)

b/ Copie des données d'une page specifique (determinée par URL

c/ de coller ces données dans une page travail.

Le point a/ est maitrisé et résolu

Le point b/ non car etant dans l'environnement web Excel est "perdu"...

Quelqu'un aurait il une idée sur ce probleme ?

Merci de votre aide

Bert

bonjour,

voici un bout de code, qui charge le code source d'une page WEB et le met à disposition En A1. à toi d'adapter ce qu'il faut faire ensuite.

Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
(ByVal pCaller As Long, ByVal szUrl As String, ByVal szFileName As String, _
 ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Function ChargerPage(ByVal url As String, ByVal Fichier As String) As Boolean
Dim done As Boolean
Dim value As Long
    On Error Resume Next
    done = True
    If Dir$(Fichier) <> "" Then
        Kill Fichier
    End If
    value = URLDownloadToFile(0, url, Fichier, 0, 0)
    If Dir$(Fichier) = "" Then
        done = False
    End If
    ChargerPage = done
End Function
Function UTF8_Decode(ByVal sStr As String)
    Dim l As Long, sUTF8 As String, iChar As Integer, iChar2 As Integer
    For l = 1 To Len(sStr)
        iChar = Asc(Mid(sStr, l, 1))
        If iChar > 127 Then
            If Not iChar And 32 Then ' 2 chars
            iChar2 = Asc(Mid(sStr, l + 1, 1))
            sUTF8 = sUTF8 & ChrW$(((31 And iChar) * 64 + (63 And iChar2)))
            l = l + 1
        Else
            Dim iChar3 As Integer
            iChar2 = Asc(Mid(sStr, l + 1, 1))
            iChar3 = Asc(Mid(sStr, l + 2, 1))
            sUTF8 = sUTF8 & ChrW$(((iChar And 15) * 16 * 256) + ((iChar2 And 63) * 64) + (iChar3 And 63))
            l = l + 2
        End If
            Else
            sUTF8 = sUTF8 & Chr$(iChar)
        End If
    Next l
    UTF8_Decode = sUTF8
End Function

Sub lirepageweb()

    url = InputBox("introduire URL ")

    fileerreur = False
    Fichier = "pagewebazerty012345.txt"

    bRet = ChargerPage("http://" & url, Fichier)
    If bRet Then
    Else
        MsgBox "Erreur lors du téléchargement"
        fileerreur = True
        Exit Sub
    End If

    If Not (fileerreur) Then
        On Error GoTo traiterreur

        Open Fichier For Input As #1
        On Error GoTo 0
    End If

    If fileerreur Then
        Close 1
        MsgBox "je n'ai pas pu récuperer le code de la page"
        Exit Sub
    End If
    codesource = Input(LOF(1), #1)
    Close 1
    tr = tr + 1
    ' décode en UTF8 si nécessaire
    codesource = UTF8_Decode(codesource)
    'à partir d'ici tu peux exploiter le contenu de ta page html, qui se trouve dans codesource
Range("A1") = codesource
    Exit Sub
traiterreur:
    fileerreur = True
    Resume Next
End Sub

Merci H2SO4, ta macro est superbe

Voici ce que j'ai pondu en me servant du code de Mathier qui avait deja etudié la question

Cela t'importe la page du site Web x dans une feuille "Work" que tu peux ensuite trier a ta guise

With Sheets("Work").QueryTables.Add(Connection:="URL;http://..nom du site..." _

, Destination:=Sheets("Work").Range("$A$1"))

.Name = "nom du site"

.FieldNames = True

.RowNumbers = False

.FillAdjacentFormulas = False

.PreserveFormatting = False

.RefreshOnFileOpen = False

.BackgroundQuery = True

.RefreshStyle = xlInsertDeleteCells

.SavePassword = False

.SaveData = True

.AdjustColumnWidth = True

.RefreshPeriod = 0

.WebSelectionType = xlEntirePage

.WebFormatting = xlWebFormattingAll

.WebPreFormattedTextToColumns = True

.WebConsecutiveDelimitersAsOne = True

.WebSingleBlockTextImport = False

.WebDisableDateRecognition = False

.WebDisableRedirections = False

.Refresh BackgroundQuery:=False

End With

Tiens comment on marque que le pb est resolu ??