Anass
-
Modifié par Chris 94 le 15/03/2017 à 14:54
Bonjour,
Je sollicite à votre aide, voila mon macro, j'ai un bouton qui me permis de lancer une recherche sur le site www.socite.com selon un numéro qui je l'ai mis dans une case dans ma feuille excel
mon problème c'est que parfois mon programme marche niquel et quand je relance le test il me donne une erreur 1004 "Erreur définie par l'application ou par l'objet"
Sub WaitIE(IE As InternetExplorer)
'On boucle tant que la page n'est pas totalement chargée
Do Until IE.readyState = READYSTATE_COMPLETE
DoEvents
Loop
End Sub
Sub Importer()
'Déclaration des variables
Dim IE As New InternetExplorer
Dim IEDoc As HTMLDocument
Dim InputGoogleZoneTexte As HTMLInputElement
Dim InputGoogleBouton As HTMLInputElement
Dim winShell As New ShellWindows
Dim URLcible As String
Siren = Sheets("Accueil").Cells(2, 1).Value
'Chargement d'une page Web Google
IE.Navigate "www.societe.com/"
'Affichage de la fenêtre IE
IE.Visible = True
'On attend le chargement complet de la page
WaitIE IE
'On pointe le membre Document
Set IEDoc = IE.document
'On pointe notre Zone de texte
Set InputGoogleZoneTexte = IEDoc.all("input_search")
'On définit le texte que l'on souhaite placer à l'intérieur
InputGoogleZoneTexte.Value = Siren
Set InputGoogleBouton = IEDoc.all("buttsearch")
InputGoogleBouton.Click
'On attend la fin de la recherche
Do While IE.Busy
Application.Wait (Now() + 1 / 3600 / 24)
Loop
Set IE = winShell(winShell.Count - 1)
URLcible = IE.LocationURL
'On libère les variables
IE.Quit
Set IE = Nothing
Set IEDoc = Nothing
'Vider la feuille temporaire
Sheets("TMP").Cells.Clear
' DerniereLigne
DerniereLigne = Sheets("TMP").Cells(2, 1).End(xlDown).Row
' L importation des données par web
With Sheets("TMP").QueryTables.Add(Connection:= _
"URL;" & URLcible, Destination:=Sheets("TMP").Range("$A$1"))
.Name = "www.socite.com"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
'Cacher la feuille temporaire
Sheets("TMP").Visible = False
'Chercher l'Adresse
For ligne = 1 To DerniereLigne
If Left(Sheets("TMP").Cells(ligne, 1), 7) = "Adresse" Then
Sheets("Accueil").Cells(2, 2) = Sheets("TMP").Cells(ligne, 2)
Exit For
Else
Sheets("Accueil").Cells(2, 2) = "Err : Données non trouvée!! "
End If
Next
'Chercher le numéro de Téléphone
For ligne = 1 To DerniereLigne
If Left(Sheets("TMP").Cells(ligne, 1), 9) = "Téléphone" Then
Sheets("Accueil").Cells(2, 6) = Sheets("TMP").Cells(ligne, 2)
Exit For
Else
Sheets("Accueil").Cells(2, 6) = "Err : Données non trouvée!! "
End If
Next
'Chercher Dénomination
For ligne = 1 To DerniereLigne
If Left(Sheets("TMP").Cells(ligne, 1), 12) = "Dénomination" Then
Sheets("Accueil").Cells(2, 8) = Sheets("TMP").Cells(ligne, 2)
Exit For
Else
Sheets("Accueil").Cells(2, 8) = "Err : Données non trouvé!! "
End If
Next
'Chercher SIRET (siege)
For ligne = 1 To DerniereLigne
If Left(Sheets("TMP").Cells(ligne, 1), 13) = "SIRET (siege)" Then
Sheets("Accueil").Cells(2, 10) = Sheets("TMP").Cells(ligne, 2)
Exit For
Else
Sheets("Accueil").Cells(2, 10) = "Err : Données non trouvé!! "
End If
Next
'Chercher Activité (Code NAF ou APE)
For ligne = 1 To DerniereLigne
If Left(Sheets("TMP").Cells(ligne, 1), 26) = "Activité (Code NAF ou APE)" Then
Sheets("Accueil").Cells(2, 12) = Sheets("TMP").Cells(ligne, 2)
Exit For
Else
Sheets("Accueil").Cells(2, 12) = "Err : Données non trouvé!! "
End If
Next
'Chercher Code Postal
For ligne = 1 To DerniereLigne
If Left(Sheets("TMP").Cells(ligne, 1), 11) = "Code postal" Then
Sheets("Accueil").Cells(2, 14) = Sheets("TMP").Cells(ligne, 2)
Exit For
Else
Sheets("Accueil").Cells(2, 14) = "Err : Données non trouvé!! "
End If
Next
'Chercher la ville
For ligne = 1 To DerniereLigne
If Left(Sheets("TMP").Cells(ligne, 1), 5) = "Ville" Then
Sheets("Accueil").Cells(2, 16) = Sheets("TMP").Cells(ligne, 2)
Exit For
Else
Sheets("Accueil").Cells(2, 16) = "Err : Données non trouvé!! "
End If
Next
'Chercher Le pays
For ligne = 1 To DerniereLigne
If Left(Sheets("TMP").Cells(ligne, 1), 4) = "Pays" Then
Sheets("Accueil").Cells(2, 17) = Sheets("TMP").Cells(ligne, 2)
Exit For
Else
Sheets("Accueil").Cells(2, 17) = "Err : Données non trouvé!! "
End If
Next
'Chercher la Catégories
For ligne = 1 To DerniereLigne
If Left(Sheets("TMP").Cells(ligne, 1), 9) = "Catégorie" Then
Sheets("Accueil").Cells(2, 18) = Sheets("TMP").Cells(ligne, 2)
Exit For
Else
Sheets("Accueil").Cells(2, 18) = "Err : Données non trouvé!! "
End If
Next
'ChercherTranche d'effectif
For ligne = 1 To DerniereLigne
If Left(Sheets("TMP").Cells(ligne, 1), 18) = "Tranche d'effectif" Then
Sheets("Accueil").Cells(2, 19) = Sheets("TMP").Cells(ligne, 2)
Exit For
Else
Sheets("Accueil").Cells(2, 19) = "Err : Données non trouvé!! "
End If
Next
End Sub