bonjour a tous
je vous propose aujourd'hui d'afficher une plage de cellule en parametre dans le corps du message du mail

mais cette fois ci se sera avec Outlook.com

lancer la sub test

le destinataire est envoyer par la sub test
1 vous avez un imputbox qui vous demande votre email tapez enter ensuite
2 un autre pour le mot de passe taper enter ensuite
quand vous arrivez sur Outlook.com la plage de cellule se trouve dans le corps du message
il vous reste plus qu'a renseigner le titre ,ajouter du texte avant ou apres la table et cliquer sur envoyer
le message part
la fenetre exel reprend la main et un message vous demande si vous voulez enregistrer vos login et mot de passe
si vous cliquez oui la sub ajoute un module portant le nom "mémoire" et enregistre les login/mot de passe en dur dans ce module

la prochaine utilisation la sub ne vous demandera rien
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
qu'en pensez vous ?