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
|
Option Explicit
Private Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub TEST()
Application.CutCopyMode = True
OUTLOOK_COM Range("b8:d13"), "destinataire@hotmail.fr"
End Sub
Sub OUTLOOK_COM(PLAGE, destinataire)
Dim reg As Boolean, pass As String, URL As String, URL2 As String, IE As Object, IEDoC As Object, log, dest As Object
Dim touche, i As Long, mess As String, reponse
Application.WindowState = xlNormal
If login = "" And passWORD = "" Then
reg = True
log = InputBox("entrez votre adresse mail ici ", "Adresse mail")
pass = InputBox("entrez votre mot de passE ici ", "mot de passe ")
If log = "" Or pass = "" Then Exit Sub
Else
log = login: pass = passWORD
End If
PLAGE.Copy
URL = "https://dub112.mail.live.com/?page=Compose"
URL2 = "https://mail.live.com/default.aspx?rru=compose"
Set IE = CreateObject("internetexplorer.application")
IE.navigate URL
IE.Visible = True
Do: DoEvents: Loop While IE.readystate <> 4 Or IE.busy = True
' ActiveWindow.WindowState = xlMinimized
Set IEDoC = IE.document
If InStr(IEDoC.Location, "https://login.live.com/login") > 0 Then
IEDoC.getelementbyid("i0116").Value = log
IEDoC.getelementbyid("i0118").Value = pass
IEDoC.getelementbyid("idSIButton9").Click
End If
Do: DoEvents: Loop Until IE.locationurl = URL
Set dest = IEDoC.getelementsbyclassname("cp_primaryInput cp_anyInput t_urtc")(0)
If Not dest Is Nothing Then dest.innertext = destinataire
Debug.Print IE.locationurl
Sleep 100
touche = Array("&H9", "&H9", "&H9", 13, 13, 17, 86)
For i = 0 To UBound(touche)
keybd_event touche(i), 0, 0, 0
Sleep 50
If i < 5 Then keybd_event touche(i), 0, &H2, 0
Sleep 100
Next
keybd_event 86, 0, &H2, 0 'on relache la touche"V" et control
keybd_event 17, 0, &H2, 0
Sleep 100
Do
DoEvents
On Error GoTo gestion_err
Loop Until IE.locationurl = "https://dub112.mail.live.com/?fid=flinbox"
IE.Quit
Application.WindowState = xlMaximized
mess = "un nouveau login/mot de passe a été entré voulez vous l'enregistreer"
If reg = True Then reponse = MsgBox(mess, vbYesNo, "Enregistrement du login/mot de passe ")
If reponse = vbYes Then regpass log, pass ' L'utilisateur a choisi Oui.
Application.CutCopyMode = False
Application.CutCopyMode = True
Exit Sub
gestion_err:
Application.WindowState = xlMaximized
mess = "un nouveau login/mot de passe a été entré voulez vous l'enregistreer"
If reg = True Then reponse = MsgBox(mess, vbYesNo, "Enregistrement du login/mot de passe ")
If reponse = vbYes Then regpass log, pass ' L'utilisateur a choisi Oui.
Application.CutCopyMode = False
Application.CutCopyMode = True
End Sub
Sub regpass(log, pass)
Dim Wb, vbe, module
'Nécéssite d'activer la référence
'"Visual basic For Application Extensibility 5.3"
' Dim Wb As Workbook
Dim VBComp As VBComponent
Dim VBComps As VBComponent
Dim X As Integer
'Définit le classeur cible
Set Wb = ThisWorkbook
Set VBComps = Wb.VBProject.VBComponents.Add(1)
VBComps.Name = "Memoire"
'Ajoute une macro dans le module
With VBComps.CodeModule
X = .CountOfLines
.InsertLines 1, "public const login =" & Chr(34) & log & Chr(34)
.InsertLines 2, "public const passWORD =" & Chr(34) & pass & Chr(34)
End With
Application.DisplayAlerts = False
ThisWorkbook.Save
End Sub
Sub testregpass()
regpass "toto", "titi"
End Sub |
Partager