VBA - Envoyer un mail via excel (outlook)

Bonjour à tous,

Je n'ai pas réussi à trouver ma solution sur le net ou sur le forum (peut être que j'ai mal chercher 8O et je m'en excuse)

Je me suis inspirer de ce sujet pour ouvrir outlook et la fenetre d'envoi d'un email avec l'ajout d'un tableau copier/coller :
https://forum.excel-pratique.com/vie...98059&start=10

Je bloque sur 3 points :
1. Le fait de coller le tableau efface complètement le contenu du mail si une signature est déjà présente lors de la création d'un nouveau mail. Je souhaiterais que le tableau soit collé avant la signature ou alors que la signature soit rechargé après le collage du tableau
2. J'ai le message d'alerte "microsoft outlook : un programme essaie d'accéder........... autoriser l'accès pour 1 minute........". Je souhaiterais autoriser par défaut puis de remettre la sécurité en place a la fermeture/fin de la macro.
3. Je souhaiterais également modifier l'adresse mail expéditeur du mail et que ce ne soit pas celle pas défaut.

Auriez vous une solution à me proposer ? Je vous remercie pour votre aide :)

Code:

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
SUB TEST
Dim OL As Object, myItem As Object, wDoc As Object, rng As Object
    Set OL = CreateObject("Outlook.Application")
    Set myItem = OL.CreateItem(olMailItem)
    Set wDoc = myItem.GetInspector.WordEditor
 
   Sheets("ZOLL_AVIS").Activate
 
   Dim TOUR As String, TOURLIG As String, IMMAT As String, PASSAGEDOUANE As String, DERLIG As Byte
   TOURLIG = Sheets("ZOLL_AVIS").Range("B1").Row
   TOUR = Sheets("ZOLL_AVIS").Range("B" & TOURLIG).Value
   IMMAT = Sheets("ZOLL_AVIS").Range("B" & TOURLIG).Offset(1, 0).Value
   PASSAGEDOUANE = Sheets("ZOLL_AVIS").Range("B" & TOURLIG).Offset(2, 1).Value
   DERLIG = Sheets("ZOLL_AVIS").Range("A" & TOURLIG).End(xlDown).Row
 
    ' On prépare le mail en rentrant les paramètres : adresse des destinataires, en copie, objet du mail, contenu du mail
 
If MsgBox("OUI/YA = Senden der Mitteilung an D610" & Chr(13) & "NON/NEIN = Senden der Mitteilung an D605", vbYesNo, "ZOLL AVIS") = vbYes Then
    With myItem
            If Sheets("EMAIL").Range("B1").End(xlDown).Row = 2 Then
            .To = Sheets("EMAIL").Range("B2").Text
            Else
            .To = Join(Application.Transpose(Sheets("EMAIL").Range("B2:B" & Sheets("EMAIL").Range("A1").End(xlDown).Row).Value), ";") '"xxx@domaine"
            End If
        '.CC = "yyy@domaine"
        .Subject = "ZOLL AVIS - TOUR " & TOUR & " - " & IMMAT & " - GRENZUBERGANG " & PASSAGEDOUANE
        .Display
 
        ' Tableau coller
        Sheets("ZOLL_AVIS").Range("A" & TOURLIG & ":G" & DERLIG).Copy
        Set rng = wDoc.Content
        rng.Paste
    End With
    Else
    With myItem
            If Sheets("EMAIL").Range("A1").End(xlDown).Row = 2 Then
            .To = Sheets("EMAIL").Range("A2").Text
            Else
            .To = Join(Application.Transpose(Sheets("EMAIL").Range("A2:A" & Sheets("EMAIL").Range("A1").End(xlDown).Row).Value), ";") '"xxx@domaine"
            End If
        '.CC = "yyy@domaine"
        .Subject = "ZOLL AVIS - TOUR " & TOUR & " - " & IMMAT & " - GRENZUBERGANG " & PASSAGEDOUANE
        .Display
 
        ' Premier tableau
        Sheets("ZOLL_AVIS").Range("A" & TOURLIG & ":G" & DERLIG).Copy
        Set rng = wDoc.Content
        rng.Paste
    End With
End If
 
    Set OL = Nothing
    Set myItem = Nothing
    Set wDoc = Nothing
END SUB