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
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