importer info d'un site internet

[mike55]

Bonjour à tous;

voila j'ai un pb, je suis debutant sur excel en vba et je dois mener à bien ce projet.

1.Objectif:
je cherche à importer du site manageo le nom du dirigant que je n'ai pas toujours ou qui n'est plus à jour.....

2.Essais:
j'ai un fichichier avec des liens vers Manageo ca marche tres bien au clik mais c'est long....alors j'ai tenter d'ecrire une macro .....mais je seche sur le sujet.....

3.Ma demande:
DU SECOURS.... idealement il faudrai un double clik par exemple et hop je traite toutes la colonne.....

MERCI PAR AVANCE.

 

[mike55]

Re : importer info d'un site internet

Ah j'ai oublier de preciser que lorque j'importe la page sur manageo ou il y a les info...je fais une recherche "nom:" et si il trouve alors c'est que l'info (nom du dirigant) se trouve dans la cellule juste à droite....

 

[PMO2]

Re : importer info d'un site internet

Bonjour,

Une piste avec le code suivant

'#############
Const DEBUT_LIEN As String = "http://www.manageo.fr/fiche_info/"

Sub GetInfoWeb()
Dim S As Worksheet
Dim S2 As Worksheet
Dim var
Dim i&
Dim j&
Dim A$
Dim bool As Boolean
Dim R As Range
Dim R1 As Range
Dim qt As QueryTable

On Error GoTo Erreur
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set S = ActiveSheet
Set R = S.UsedRange
var = R
For i& = 1 To UBound(var, 1)
If Left(var(i&, 1), Len(DEBUT_LIEN)) = DEBUT_LIEN Then
If Not bool Then
Set S2 = Sheets.Add(After:=Sheets(Sheets.Count))
bool = True
End If
A$ = "url;" & var(i&, 1)
With S2
.Cells.Delete
Set qt = .QueryTables.Add(Connection:=A$, Destination:=.[a1])
qt.SavePassword = True
qt.Refresh BackgroundQuery:=False
Set R1 = Cells.Find("Nom :", LookIn:=xlValues)
If Not R1 Is Nothing Then
var(i&, 7) = R1.Offset(0, 1).Value
End If
End With
End If
Next i&
S2.Delete
S.Copy before:=Sheets(1)
Set S2 = Sheets(1)
S2.Activate
S2.Range(R.Address) = var
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Exit Sub
Erreur:
ActiveSheet.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Le programme n'a pas pu s'exécuter"
End Sub
'#############

Cordialement.

PMO
Patrick Morange