1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140
| Sub connection()
Dim IEdoc As Object
Dim DOCelement As Object
Set ie = CreateObject("InternetExplorer.application")
ie.Visible = False
ie.Navigate ("https://*******")
'attente de fin de chargement
Do Until ie.ReadyState = 4
DoEvents
Loop
Set IEdoc = ie.Document
'login
Set DOCelement = IEdoc.getElementsByName("LoginForm_Login").Item
DOCelement.Value = "*******@gmail.com" 'Login
'password
Set DOCelement = IEdoc.getElementsByName("LoginForm_Password").Item
DOCelement.Value = "******" 'mot de passe
'account
Set DOCelement = IEdoc.getElementsByName("LoginForm_RegistrationDomain").Item
DOCelement.Value = "*******"
DOCelement.Select
'connexion
Set DOCelement = IEdoc.Forms(0)
DOCelement.submit
Application.Wait (Now + TimeValue("0:00:03"))
ie.Navigate ("https://********")
'attente de fin de chargement
Do Until ie.ReadyState = 4
DoEvents
Loop
'copie page
With ie.Document
Application.SendKeys "^a"
Application.Wait Now + TimeValue("00:00:1")
Application.SendKeys "^c"
End With
'attente de fin de chargement
Do Until ie.ReadyState = 4
DoEvents
Loop
'appelle fonction Insere Feuille Temporaire
Call InsereFeuille
'colle Feuille Temporaire
Sheets("Temp1").Activate
Range("a1").Select
ActiveSheet.Paste
Sheets("List").Activate
'appelle fonction List
Call List
'appelle fonction Supprime Feuille Temporaire
Call SupprimeFeuille
'Fin
Set IEdoc = ie.Document
ie.Quit
Sheets("Button").Range("D2") = "OK"
End Sub
Sub InsereFeuille()
Sheets.Add.Move After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "Temp1"
End Sub
Sub SupprimeFeuille()
Sheets("Temp1").Delete
End Sub
Sub List()
Sheets("List").Cells.Clear
Dim i As Integer
Dim j As Integer
Dim HyperLinks As String
Dim ListHyperlinks As String
For i = 82 To 131
Sheets("List").Cells(i - 81, 1) = "N° de commande List : " & Sheets("Temp1").Cells(i, 5)
Sheets("List").Cells(i - 81, 2) = "Date : " & Sheets("Temp1").Cells(i, 1)
Sheets("List").Cells(i - 81, 3) = "Réf. cde : " & Sheets("Temp1").Cells(i, 3)
Sheets("List").Cells(i - 81, 4) = "Réf. chantier : " & Sheets("Temp1").Cells(i, 4)
Sheets("List").Cells(i - 81, 5) = "Total: " & Sheets("Temp1").Cells(i, 7)
Sheets("List").Cells(i - 81, 6) = "Status: " & Sheets("Temp1").Cells(i, 6)
ListHyperlinks = Sheets("Temp1").Cells(i, 3).HyperLinks(1).Address
HyperLinks = Link(ListHyperlinks)
Sheets("List").Cells(i - 81, 8) = HyperLinks
If Sheets("Temp1").Cells(i, 8) <> "" Then
ListHyperlinks = Sheets("Temp1").Cells(i, 8).HyperLinks(1).Address
HyperLinks = ListHyperlinks
Sheets("List").Cells(i - 81, 9) = HyperLinks
End If
Next
Sheets("List").Columns(6).Replace "Status: Livrée", "Status: Livrée en totalité "
Sheets("List").Columns(6).Replace "Status: Enregistrée", "Status: En préparation "
Sheets("List").Columns(6).Replace "Status: Facturée", "Status: Livrée et facturée "
Sheets("List").Columns(6).Replace "Status: Partiellement livrée", "Status: Partiellement livrée "
Sheets("List").Columns(6).Replace "Status: Partiellement facturée", "Status: Partiellement livrée "
End Sub
Function Link(AdressSanelec As String)
Dim LinkPos As Integer
Dim LinkTemp As String
LinkTemp = AdressSanelec
Dim LinkAdress1 As String
LinkAdress1 = "https://**********"
Dim LinkAdress2 As String
LinkAdress2 = "&OrderID="
LinkTemp = Mid(LinkTemp, 123, 24)
Link = LinkAdress1 & LinkTemp & LinkAdress2 & LinkTemp
End Function |
Partager