Verifier si user authentifié sur page Web puis Importer une table

YAKA2009

XLDnaute Nouveau
Bonjour,

Import de page web avec controle authentification

Sur excel 2010, j'importe une table depuis un site web.
Lorsque je ne me suis pas identifié , je peux via vba saisir identifiant et mot de passe.
Il arrive souvent que je sois deja identifié sur la page, dans ce cas mon code plante.
Mon objecitf est le suivant :

1. se connecter à la page web.
2. Contrôler si user conecté,
3. si user connecté importer la table
4. si user par connecté saisir identifiant et mot de passe puis importer table
5. deconnecter user.


voici le code, j'ai modifié les données confidentielles


Sub bz_tdb_xls2010()
'
' bz_tdb_xls2010 Macro
'


'

Const MY_URL As String = "https://bugzilla.axa-assistance.com.ar"
Const IDENTIFIANT As String = "user_login"
Const PASSWORD As String = "mon_password"

Dim IE As Object 'SHDocVw.InternetExplorer
Set IE = CreateObject("InternetExplorer.Application")
Dim IEDoc As HTMLDocument


ThisWorkbook.Sheets("Feuil2").Activate
ThisWorkbook.Sheets("Feuil2").Cells.ClearContents


With IE
.Silent = False
.navigate MY_URL
Do Until .readyState = 4
DoEvents
Loop
End With



If (IE.document.all("Bugzilla_login_top").Visible = True) Then
IE.document.all("Bugzilla_login_top").Value = IDENTIFIANT
IE.document.all("Bugzilla_password_top").Value = PASSWORD
IE.document.all("log_in_top").Click
IE.Visible = True
End If

With ActiveSheet.QueryTables.Add(Connection:= _
"URL;https://bugzilla.axa-assistance.com.ar/buglist.cgi?&list_id=416169" _
, Destination:=Range("$A$1"))
.Name = _
"buglist.cgi?cmdtype=runnamed&namedcmd=&list_id=416169"
.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
Rows("1:24").Select
Selection.Delete Shift:=xlUp
Range("A1").Select
ActiveCell.FormulaR1C1 = "ID"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Opened"
Columns("A:A").Select
Selection.Replace What:="[SEC]", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Select
Selection.AutoFilter
Range("A1").Select


End Sub

MsgBox ("Done!")
End Sub
 

Discussions similaires

Réponses
22
Affichages
1 K
Haut Bas