signature automatique outlook mauvaise place

[tonton]

Bonjour,

Suite à mes recherche sur différent forum, je me suis décidé à vous poser la question car je n'ai rien trouvé.
J'ai fait une macro qui me permet d'envoyer un mail automatiquement un pdf dans lequel j'ai inséré la signature par défaut de mon outlook.
Le problème est que la signature se retrouve en haut du mail au lieu d'etre placé en bas du corps de message.
voici mon code:


With OutMail
.To = Range("BD2")
.CC = ""
.BCC = ""
.Subject = "Planning_" & Range("E2") & "_" & Format(Now(), "dd-mm-yyyy")
.Body = "Bonjour," & vbCrLf & vbCrLf & "Veuillez trouver ci-joint votre planning." & vbCrLf & vbCrLf & Range("BM7") & vbCrLf & vbCrLf & "Cordialement."
.Attachments.Add (Range("BD1") & "\" & "Planning_" & Range("E2") & "_" & Format(Now(), "yyyy-MM-dd") & ".pdf")
.display
.GetInspector.CommandBars.Item("Insert").Controls("Signature").Controls(1).Execute
.display

Merci pour l'aide que vous voudriez bien m'apporter

 

[Yaloo]

Re : signature automatique outlook mauvaise place

Bonjour tonton,

Voici un code, de Ron de Bruin (je crois), qui devrait te premettre de positionner ta signature à la fin du corps de ton mail.

  'recupere la signature outlook, definis à qui envoyer, l'objet et ajoute la signature outlook au corps du mail "strbody"
  MaSignature = "Le nom de ta signature.htm" 'A adapter
  'Normalement l'emplacement est dans AppData\Microsoft\Signatures\
  SigString = Environ("appdata") & "\Microsoft\Signatures\" & MaSignature
  'Vérification de la présence de la signature dans le répertoire
  If Dir(SigString) <> "" Then
    Signature = GetBoiler(SigString)
   Else
    Signature = ""
  End If

  With OutMail
    .To = Range("BD2")
    .CC = ""
    .BCC = ""
    .Subject = "Planning_" & Range("E2") & "_" & Format(Now(), "dd-mm-yyyy")
    .Body = "Bonjour," & vbCrLf & vbCrLf & "Veuillez trouver ci-joint votre planning." & vbCrLf & vbCrLf & Range("BM7") & vbCrLf & vbCrLf & "Cordialement." & Signature
    .Attachments.Add (Range("BD1") & "\" & "Planning_" & Range("E2") & "_" & Format(Now(), "yyyy-MM-dd") & ".pdf")
    .display
  End With

A+

Martial

 

[tonton]

Re : signature automatique outlook mauvaise place

Bonjour Yaloo (Martial)

Merci pour ton aide mais cette manière, je pense ne convient pas car vu que le fichier est amené à être utilisé par plusieurs utilisateur, je préférais justement utiliser la signature par defaut d'outlook afin que le mail soit envoyé avec la signature de l'utilisateur automatiquement.

Je ne suis pas un As de la VBA mais je continu à analyser ce que tu m'a envoyé afin de voir s'il y a possibilité de le modifier.

Je suis à l'ecoute de vos suggestions.

 

[Yaloo]

Re : signature automatique outlook mauvaise place

Re,

Connais-tu tous les utilisateurs de ce fichier ?
Sont-ils mémorisés dans le classeur ? Nom - Adresse mail etc...
Le fichier sera sur plusieurs PC ? Ou un seul ?

A te relire

Martial

 

[tonton]

Re : signature automatique outlook mauvaise place

Sur mon fichier il y aura seulement l'adresse mail du destinataire.
Mon fichier reste donc adaptable à n'importe quel PC à partir du moment qu'il a excel et outlook...Autrement dit je n'ai pas envie de le restreindre à un groupe d'utilisateurs.

 

[Yaloo]

Re : signature automatique outlook mauvaise place

Je n'ai pas de solution. Sauf si l'on fait une recherche des signatures présentes sur le PC et ajout avec l'acceptation de l'utilisateur. Mais là, ça commence à devenir lourd

A+

 

[tonton]

Re : signature automatique outlook mauvaise place

Je pensais que c'était seulement un problème de curseur ou de temporisation mais bon vu ce que tu me dis ce n'est pas aussi évident... je vais continuer mes recherches.

En tout cas je te remercie beaucoup pour le temps que tu m'as accordé.

Je reste en veille si quelqu'un à eu le même soucis et qu'il a réussi à trouver une solution

A+

 

[mromain]

Re : signature automatique outlook mauvaise place

Bonjour tonton, Martial, le forum,

Il est difficile de connaitre la signature par défaut en VBA dans Outlook…
Suite à des recherches, il semble que cette information soit stockée (en hexadécimal) dans la base de registre.

On peut néanmoins récupérer toutes les signatures de l'utilisateur courant à partir des fichiers .htm situés dans le dossier %APPDATA%\Roaming\Microsoft\Signatures avec cette fonction :

Public Function UserSignatures() As Collection
Dim oFso As Object, curFile As Object
    Set UserSignatures = New Collection
    Set oFso = CreateObject("Scripting.FileSystemObject")
    'boucler sur tous les fichiers du dossier %APPDATA%\Roaming\Microsoft\Signatures
     For Each curFile In oFso.GetFolder(Environ("APPDATA") & "\Microsoft\Signatures").Files
        'si le fichier est un .htm (signature), récupérer son contenu
         If LCase(curFile.Name) Like "*.htm" Then UserSignatures.Add oFso.OpenTextFile(curFile.Path, 1).ReadAll, Left(curFile.Name, Len(curFile.Name) - 4)
    Next curFile
    
    Set oFso = Nothing
End Function

Ainsi, il est possible d'ajouter une signature au mail avec ce code :

Sub test()
Dim signaturesHtml As Collection, oMail As MailItem
    
    'récupérer les signatures
     Set signaturesHtml = UserSignatures()
    If signaturesHtml.Count = 0 Then Stop       'si arrêt, pas de signatures trouvées
    
    'ajouter la première signature trouvée au mail
     oMail.HTMLBody = oMail.HTMLBody & signaturesHtml(1)
    
    'ou, ajouter la signature nommée "Signature de test" au mail
     oMail.HTMLBody = oMail.HTMLBody & signaturesHtml("Signature de test")

End Sub

Les signatures étant au format html, attention à utiliser oMail.Ce lien n'existe plus et non oMail.Body.

A+

 

[Yaloo]

Re : signature automatique outlook mauvaise place

Bonsoir Romain, tonton,

Pour aller dans le sens de Romain, vois avec la fonction de Romain légèrement modifié pour récupérer le chemin des signatures :

Public Chemin
Public Function UserSignatures() As Collection
Dim oFso As Object ', curFile As File
  Set UserSignatures = New Collection
  Set oFso = CreateObject("Scripting.FileSystemObject")
  'boucler sur tous les fichiers du dossier %APPDATA%\Roaming\Microsoft\Signatures
  For Each curFile In oFso.GetFolder(Environ("APPDATA") & "\Microsoft\Signatures").Files
    'si le fichier est un .htm (signature), récupérer son contenu
    If LCase(curFile.Name) Like "*.htm" Then
      UserSignatures.Add oFso.OpenTextFile(curFile.Path, 1).ReadAll, Left(curFile.Name, Len(curFile.Name) - 4)
    End If
  Next curFile
  Chemin = oFso.GetFolder(Environ("APPDATA") & "\Microsoft\Signatures")
  
  Set oFso = Nothing
End Function

Puis ta macro, avec possibilité soit de ne rien mettre s'il n'y a pas de signature, de mettre par défaut la signature s'il n'y en a qu'une et le choix fait par l'utilisateur s'il y a plusieurs signatures :

Sub test()
Dim signaturesHtml As Collection, OutMail As MailItem
  'récupérer les signatures
  Set signaturesHtml = UserSignatures()
  'Set oFso = CreateObject("Scripting.FileSystemObject")
  Select Case signaturesHtml.Count
    Case 0: Signature = ""
    Case 1: Signature = signaturesHtml(1)
    Case Else
      ChDir Chemin
      FichierChoisi = Application.GetOpenFilename(", *.htm")
      Signature = Mid(FichierChoisi, InStrRev(FichierChoisi, "\") + 1)
  End Select
    
  With OutMail
    .To = Range("BD2")
    .CC = ""
    .BCC = ""
    .Subject = "Planning_" & Range("E2") & "_" & Format(Now(), "dd-mm-yyyy")
    .HTMLBody = "Bonjour," & vbCrLf & vbCrLf & "Veuillez trouver ci-joint votre planning." & vbCrLf & vbCrLf & Range("BM7") & vbCrLf & vbCrLf & "Cordialement." & Signature
    .Attachments.Add (Range("BD1") & "\" & "Planning_" & Range("E2") & "_" & Format(Now(), "yyyy-MM-dd") & ".pdf")
    .display
  End With
End Sub

A+

Martial

 

[tonton]

Re : signature automatique outlook mauvaise place

Bonjour Tout le monde,

Merci beaucoup pour votre contribution, toujours aussi ravi d'être sur ce forum d'expert !! je test tout cela

A+