Création par VBA d'une base de mots-clés pour moteur JS


Il s'agit de créer une page HTML qui va servir de base de données à notre moteur de recherche JavaScript.
La structure de base est simple :
<BR><A HREF="url1" NAME="titre1, mots-clés = motclé1, motclé2"></A>
<BR><A HREF="url2" NAME="titre2, mots-clés = motclé3, motclé4, motclé5"></A>
<BR><A HREF="url3" NAME="titre3, mots-clés = motclé6"></A>
...

Tous les éléments sont issus des pages du site à explorer, les URL sont les adresses des pages du site, les titres sont compris entre les balises <TITLE> et les mots-clés sont tirés des balises <META MAME="keywords">.

Reste à écrire une macro qui va ouvrir successivement toutes les pages du site, en extraire les titres et mots-clés, et les recopier dans une nouvelle page html.
On suppose que toutes les pages à explorer sont dans le même répertoire (C:\cours_xl dans l'exemple) et nous créons la base de données sous forme d'une nouvelle page HTML dans le même répertoire.

Le fichier HTML devant servir de base de données est créé comme un simple fichier texte en utilisant Open rép & "\" & nom_base For Output As #1
Toutes les entêtes HTML et les scripts JavaScript sont recopiés en utilisant Print. Attention aux guillemets contenus dans le code à recopier. Il faut dans certains cas les remplacer par des apostrophes (guillemets simples) ou bien par CHR(34).
Reste à ajouter les liens pointant vers les pages du site, avec comme "NAME" le titre de la page et ses mots-clés.
Le répertoire contenant les pages du site est parcouru à la recherche de pages portant l'extension html en utilisant Dir(rép & "\*.html").
Chacune des pages est ouverte en lecture par Open rép & "\" & fich For Input Access Read As #2
puis parcourue à la recherche des mot "TITLE" et "Keywords".
Titre, url et mots-clés sont associés pour former un lien qui est inscrit dans notre page base de données en utilisant encore Print.
Une fois toutes les pages parcourues, on ferme le fichier qui est prêt pour l'utilisation.

Sub crée_base()
'rép est le répertoire contenant les pages à explorer et le fichier base de données
rép = "C:\cours_xl"
'nom_base est le nom de la page html à créer ou mettre à jour
nom_base = "exemple_js6.html"
'créer le nouveau fichier
Open rép & "\" & nom_base For Output As #1
'y inscrire les entêtes et codes javascript
Print #1, Chr(10) & "<HTML><HEAD>"
Print #1, Chr(10) & "<SCRIPT>"
Print #1, Chr(10) & "function liste() {"
Print #1, Chr(10) & "cle = prompt('tapez le mot clé à rechercher dans la base', 'excel').toLowerCase()"
Print #1, Chr(10) & "txt='<HTML><BODY>';"
Print #1, Chr(10) & "for (num=1;num<=document.links.length;num++)"
Print #1, Chr(10) & "{if (document.links[num-1].name.indexOf(cle)>-1)"
Print #1, Chr(10) & "{txt=txt+'<A HREF=" & Chr(34) & "'+document.links[num-1].href+'" & Chr(34) & ">'+document.links[num-1].name+'</A><BR><BR>';"
Print #1, Chr(10) & "txt=txt+'</BODY></HTML>';"
Print #1, Chr(10) & "document.open();"
Print #1, Chr(10) & "document.write(txt);"
Print #1, Chr(10) & "document.close()"
Print #1, Chr(10) & "}"
Print #1, Chr(10) & "</SCRIPT></HEAD>"
Print #1, Chr(10) & "<BODY onload='liste()'>"
'parcourir les pages du site
fich = Dir(rép & "\*.html")
encore:
clé = ""
titre = ""
If fich <> nom_base Then
'ouvrir la page à explorer
Open rép & "\" & fich For Input Access Read As #2
'parcourir la page
Do While Not EOF(2)
'mots clés
Line Input #2, txte
txt = LCase(txte)
If InStr(1, txt, "keywords") > 0 And InStr(1, txt, "content") > 0 Then
txt = Mid(txt, InStr(1, txt, "content") + 9, Len(txt) - InStr(1, txt, "content") - 10)
clé = txt
End If
'titre
txt = LCase(txte)
If InStr(1, txt, "/title") > 0 Then
txt = Mid(txt, InStr(1, txt, "title") + 6, Len(txt) - InStr(1, txt, "title") - 13)
titre = txt
End If
Loop
Close #2 'fin de l'exploration de la page
'inscrire le résultat dans le fichier base de données
If clé <> "" Then
Print #1, Chr(10) & "<A HREF='" & fich & "' NAME='" & titre & " (mots clés = " & clé & ")'></A>"
End If
End If 'fin de fich n'est pas la bd
'passer au fichier suivant
fich = Dir
If fich <> "" Then GoTo encore
'imprimer le bas de la page et fermer la base
Print #1, Chr(10) & "</BODY></HTML>"
Close #1
End Sub


Cliquez ici pour télécharger le fichier Excel permettant de générer le moteur de recherche JavaScript (fichier Zip 21 ko). (La macro qu'il contient est un peu plus élaborée que celle qui est présentée ci-dessus.