Discussion :

[nounoux]

Hello every body,

J'ai besoin de votre aide.

Voila, je récupère le code source d'une page web que j'enregistre en format .txt

Ce que je voudrais maintenant c'est à partir de ce fichier txt récupérer tous les liens internet qui sont présents et les mettre sur une feuille excel pour exécuter des taches particulières.

Exemple de lien présent dans le fichier.txt
<a href="http://www.xxxxx.fr/12520000.htm?dc=10_s">
Nota , ils n'ont pas tous le même nombre de caractères.

Si quelqu'un aurait déjà une macro Excel qui fait ce genre de chose je suis preneur.

P.S : je ne suis pas informaticien.

[Psychopathe]

C'est très audacieux. Pour que le code fonctionne, il faut ajouter la référence Microsoft Scripting Runtime

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
 
Public Sub chercherLiens()
 
'Ajouter la référence Microsoft Scripting Runtime
 
Dim chaine As String, sousChaine As String, fso As Scripting.FileSystemObject, fichier As Scripting.File
Dim nomFichierTexte As String, texte As Scripting.TextStream, i As Integer, debut As Integer, fin As Integer
Dim chaineRecherche As String, chaineFin As String
 
'Les lien commencent par la chaine a hrep=
chaineRecherche = "a hrep="""
'Fin de la balise
chaineFin = """>"
'Nom du fichier texte
nomFichierTexte = "liens.txt"
 
Set fso = New Scripting.FileSystemObject
'On suppose que le fichier texte "liens.txt" est dans le même répertoire que le classeur Excel
Set fichier = fso.GetFile(ThisWorkbook.Path & "\" & nomFichierTexte)
Set texte = fichier.OpenAsTextStream(ForReading)
 
i = 1
 
Do
    chaine = texte.ReadLine
    fin = 1
    debut = InStr(fin, chaine, chaineRecherche, vbTextCompare)
    'Il peut y avoir plusieurs liens sur la même ligne
    While (debut > 0)
        'On récupère la position de fin du lien via la variable chaineFin
        fin = InStr(debut, chaine, chaineFin, vbTextCompare)
        'On récupère le lien
        sousChaine = Mid(chaine, debut + Len(chaineRecherche), fin - debut - Len(chaineRecherche))
        'On écrit le lien dans les cellules de la feuille Feuil1
        Feuil1.Range("A" & i) = sousChaine
        i = i + 1
        'On cherche le début d'un éventuel nouveau texte "a hrep="
        debut = InStr(fin + 1, chaine, chaineRecherche, vbTextCompare)
    Wend
Loop Until texte.AtEndOfStream
 
texte.Close
'On fait du ménage au niveau des variables
Set texte = Nothing
Set fichier = Nothing
Set fso = Nothing
 
 
End Sub

[PPz78]

Bonsoir,

Vous avez sûrement tous vu la petite erreur dans le code, au lieu de
chaineRecherche = "a hrep=""" il faut écrire
chaineRecherche = "a href="""

[SilkyRoad]

Bonjour,

Il est également possible d'extraire tous les liens hypertextes d'une page html directement sans passer par un fichier texte :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
'nécessite d'activer la référence Microsoft HTML Objects Library
'nécessite d'activer la référence Microsoft Internet Controls
 
Dim IE As New InternetExplorer
Dim x As Integer
Dim Doc As HTMLDocument
 
IE.Navigate "http://www.developpez.com"
Do Until IE.ReadyState = READYSTATE_COMPLETE
DoEvents
Loop
 
Set Doc = IE.Document
 
For x = 0 To Doc.Links.Length - 1
   Cells(x + 1, 1) = Doc.Links(x)
Next
 
MsgBox "fini"
 
IE.Quit
Set IE = Nothing

bonne journée
michel