Microsoft 365 Mise en page mail/vba

Dju1 · 2 Octobre 2023

Bonjour à tous,
je suis à la fin d'une VBA, avec une grosse aide d'un membre du forum, mais je bloque sur la mise en page. J'aimerai inséré une image, ma vba "fonctionne" mais je ne comprend pas pourquoi l'image ne s'affiche pas (j'ai un cadre que je peux redimensionner mais rien dedans)
Et j'aurais aussi aimer intégrer des espaces avant la date.
Merci d'avance

VB:

      Txt = " <p> Bonjour, <p> Suite à notre entretien téléphonique je vous confirme le rendez-vous pour le début de votre chantier le <p> <b>"
      Txt = Txt & Format(Dat, "dddd dd/mm/yyyy") & _
        " à partir de 7h30 </b> <p> A noter que nos poseurs sont habilités à réceptionner le chantier et à percevoir le solde restant dû, merci de " & _
        "prendre vos dispositions afin que cela soit respecté à la fin des travaux. "
      With m
        .Subject = "Confirmation de rendez-vous"
        .htmlBody = "<img src=C:\Users\adv.\Downloads\logo.jpg\>" & Txt
        .Recipients.Add Target.Offset(, -1)
        .display

mromain · 3 Octobre 2023

Dju1 à dit:
Bonjour Romain,
merci pour le coup de main, ça fonctionne parfaitement pour le décrochage sur la droite, je vais avoir besoin d'ajouter d'autres espaces mais je devrais m'en sortir.
Ne me reste plus que la signature, mais là je t'avoue que ça devient complexe pour moi. Je mets le code si jamais quelqu'un peut prendre le temps de m'apporter un peu d'aide

Merci d'avance

VB:

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) Dim Dat As Variant, C As Range, Txt As String, Col As Integer Dim L As Integer Dim objOL As Object, ObjMail As Object Dim oAttach As Object, ColAttach As Object Set objOL = CreateObject("Outlook.Application") Set ObjMail = objOL.CreateItem(0)...

Oneida · 2 Octobre 2023

Bonjour,
Code trouve a la suite d'une recherche et adapte a votre morceau de code. Test: voir image

Une erreur sur .recipient dans votre code , mis en commentaire

VB:

Sub test_image_corps_message()

    Dim objOL As Object, ObjMail As Object
    Dim oAttach As Object, ColAttach As Object
 
    Set objOL = CreateObject("Outlook.Application")
    Set ObjMail = objOL.CreateItem(0)
    Set ColAttach = ObjMail.attachments
    Set oAttach = ColAttach.Add("C:\Users\adv.\Downloads\logo.jpg") 'Changer le chemin et le nom de l'image
    '------------------------------
        Txt = " <p> Bonjour, <p> Suite à notre entretien téléphonique je vous confirme le rendez-vous pour le début de votre chantier le <p> <b>"
        Txt = Txt & Format(Dat, "dddd dd/mm/yyyy") & _
        " à partir de 7h30 </b> <p> A noter que nos poseurs sont habilités à réceptionner le chantier et à percevoir le solde restant dû, merci de " & _
        "prendre vos dispositions afin que cela soit respecté à la fin des travaux. "
    With ObjMail
        .to = Cells(8, 11)
        .CC = Cells(9, 11)
        .Subject = "Confirmation de rendez-vous"
        .htmlBody = "<BODY><IMG src=cid:logo.jpg<\BODY>" & Txt
        '.Recipients.Add Target.Offset(, -1)  ??????
        ObjMail.Save
        .display    'Send   Display permet d'afficher le message, Send l'envoie sans affichage
    End With
 
'    ActiveWorkbook.Close
 
    Set oAttach = Nothing
    Set ColAttach = Nothing
    Set ObjMail = Nothing
    Set objOL = Nothing
End Sub

Dju1 · 2 Octobre 2023

Bonjour Oneida,
merci de ton aide, ça fonctionne plutôt bien. J'ai 2 adresses mail (l'une est l'en tete d'un tableau) qui se renseigne mais je vais chercher la cause.

J'ai oublié de préciser que j'aurais besoin de la signature également. Est-ce possible de l'ajouter à htmlbody ?
Merci d'avance

Dju1 · 2 Octobre 2023

J'ai trouvé la solution pour l'adresse mail, il s'agissait d'une adaptation à mon fichier.

Pour en finir avec cette vba il ne me reste qu'à insérer des espaces avant la date et insérer la signature... Si jamais l'un d'entre vous à la solution, je reste à l'écoute

Oneida · 3 Octobre 2023

Bonjour,

un autre exemple. Pour les espaces, perso je les mets a la mano, ai pas trouve mieux sauf des variables definies avec un nombre espaces

VB:

'http://www.rondebruin.nl/win/s1/outlook/signature.htm
Sub Mail_Outlook_With_Signature_Html_2()
' Don't forget to copy the function GetBoiler in the module.
' Working in Office 2000-2016
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim SigString As String
    Dim Signature As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    strbody = "<H3><B>Dear Customer Ron de Bruin</B></H3>" & _
              "Please visit this website to download the new version.<br>" & _
              "Let me know if you have problems.<br>" & _
              "<A HREF=""http://www.rondebruin.nl/tips.htm"">Ron's Excel Page</A>" & _
              "<br><br><B>Thank you</B>"

    'Change only Mysig.htm to the name of your signature
    SigString = Environ("appdata") & "\Microsoft\Signatures\Mysig.htm"    'fichier signature a creeer

    If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If

    On Error Resume Next

    With OutMail
        .To = "ron@debruin.nl"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .HTMLBody = strbody & "<br>" & Signature
        'or use
        .Display
        '.Send
    End With

    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub


Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function

mromain · 3 Octobre 2023

Bonjour Dju1, Oneida le forum,

Pour le problème d'espaces avant la date, tu peux :

Soit utiliser des espaces insécables avant la date (ajouter " " pour chaque espace) ;
Soit faire un décrochage sur la droite (ajouter "<dd>" avant la date et "</dd>" après.

Pour la signature, le code de rondebruin proposé par Oneida peut poser problème si la signature contient des images.
Si tel est le cas, tu trouveras une alternative ici.

A+

Dju1 · 3 Octobre 2023

Bonjour Romain,
merci pour le coup de main, ça fonctionne parfaitement pour le décrochage sur la droite, je vais avoir besoin d'ajouter d'autres espaces mais je devrais m'en sortir.
Ne me reste plus que la signature, mais là je t'avoue que ça devient complexe pour moi. Je mets le code si jamais quelqu'un peut prendre le temps de m'apporter un peu d'aide

Merci d'avance

VB:

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
  Dim Dat As Variant, C As Range, Txt As String, Col As Integer
  Dim L As Integer
  Dim objOL As Object, ObjMail As Object
  Dim oAttach As Object, ColAttach As Object
 
  Set objOL = CreateObject("Outlook.Application")
    Set ObjMail = objOL.CreateItem(0)
    Set ColAttach = ObjMail.attachments
    Set oAttach = ColAttach.Add("C:\Users\adv\Downloads\logo.jpg")
 
  If Sh.Name <> "LIEN WAZE" And Sh.Name <> "Config" Then
    Cancel = True
    If Target.Value = "*" Then
      If Target.Count > 1 Then Exit Sub
      If Target.Column <> 20 Or Target.Row < 9 Then Exit Sub
      Set olApp = CreateObject("Outlook.application")
      With Sh
        L = .[V:V].Find("*", , , , xlByRows, xlPrevious).Row + 1
        Col = Application.Match("PLANNING D'INTERVENTION", .[6:6], 0)
        For Each C In .Cells(9, Col).Resize(L, 5)
          If C = .Cells(Target.Row, 1) Then
            If .Cells(8, C.Column) < Dat Or Dat = "" Then
              Dat = .Cells(8, C.Column)
            End If
          End If
        Next C
      End With
      Txt = " <p> Bonjour, <p> Suite à notre entretien téléphonique je vous confirme le rendez-vous pour le début de votre chantier le <p> <b>"
      Txt = Txt & "<dd>" & Format(Dat, "dddd dd/mm/yyyy") & _
        " à partir de 7h30 </b> </dd> <p> A noter que nos poseurs sont habilités à réceptionner le chantier et à percevoir le solde restant dû, merci de " & _
        "prendre vos dispositions afin que cela soit respecté à la fin des travaux. "
      With ObjMail
        .Subject = "Confirmation de rendez-vous"
        .htmlBody = "<BODY><IMG src=cid:logo.jpg<\BODY>" & Txt
        .Recipients.Add Target.Offset(, -1)
        .display
        
      End With
      
    Set oAttach = Nothing
    Set ColAttach = Nothing
    Set ObjMail = Nothing
    Set objOL = Nothing
    End If
  End If
End Sub

Dju1 · 3 Octobre 2023

Oneida, j'ai dû bougé quelque chose, je n'arrive pas à voir quoi puisque je n'ai plus la date qui apparait sur mes semaines autre que la 1ère.

patricktoulon · 3 Octobre 2023

bonjour à tous
juste en passant

la balise P est une balise paragraphe
si tu met <p> blablabla <p> blablabla tu met le outertext de la p(2) dans le innertext de p(1)
de ce fait les espaces et autre inconvenue sont pris comme du texte et le whitespace n'est plus pris en compte

a imbriquer des balises P vous risquez une interprétation différente selon l'application mail de votre client

VB:

Sub test()
    dat = Date
    txt = " <p> Bonjour,</p>"
    txt = txt & "<p> Suite à notre entretien téléphonique je vous confirme le rendez-vous pour le début de votre chantier le <p>"
    txt = txt & "<p><dd><b>" & Format(dat, "dddd dd/mm/yyyy") & " à partir de 7h30 </b></dd></p> "
    txt = txt & "<p> A noter que nos poseurs sont habilités à réceptionner le chantier et à percevoir le solde restant dû, merci de " & _
          "prendre vos dispositions afin que cela soit respecté à la fin des travaux.</p> "


    'si vous avez encore internet explorer qui fonctionne
    'vous pouvez en avoir un apercu du résultat avec le code ci dessous
    With CreateObject("internetexplorer.application")
        .navigate "about:blank"
        .Visible = True
        Do While .readystate < 4: DoEvents: Loop
        .document.write txt
    End With
End Sub

VB:

Sub test2()
    dat = Date
    txt = " <p> Bonjour,</p>"
    txt = txt & "<p> Suite à notre entretien téléphonique je vous confirme le rendez-vous pour le début de votre chantier le <p>"
    txt = txt & "<p><blockquote><b>" & Format(dat, "dddd dd/mm/yyyy") & " à partir de 7h30 </b></blockquote></p> "
    txt = txt & "<p> A noter que nos poseurs sont habilités à réceptionner le chantier et à percevoir le solde restant dû, merci de " & _
          "prendre vos dispositions afin que cela soit respecté à la fin des travaux.</p> "


    'si vous avez encore internet explorer qui fonctionne
    'vous pouvez en avoir un apercu du résultat avec le code ci dessous
    With CreateObject("internetexplorer.application")
        .navigate "about:blank"
        .Visible = True
        Do While .readystate < 4: DoEvents: Loop
        .document.write txt
    End With
End Sub

exemple 3
avec l'attribut text-indent à attribuer au P concerné
a noter que j'indente avec le mode length en pixels
cette dimension peut être modifiée à souhait

VB:

Sub test3()
    dat = Date
    txt = " <p> Bonjour,</p>"
    txt = txt & "<p> Suite à notre entretien téléphonique je vous confirme le rendez-vous pour le début de votre chantier le <p>"
    txt = txt & "<p style="" Text-Indent:50px;""><b>" & Format(dat, "dddd dd/mm/yyyy") & " à partir de 7h30 </b></p> "
    txt = txt & "<p> A noter que nos poseurs sont habilités à réceptionner le chantier et à percevoir le solde restant dû, merci de " & _
          "prendre vos dispositions afin que cela soit respecté à la fin des travaux.</p> "


    'si vous avez encore internet explorer qui fonctionne
    'vous pouvez en avoir un appercu du résultat avec le code ci dessous
    With CreateObject("internetexplorer.application")
        .navigate "about:blank"
        .Visible = True
        Do While .readystate < 4: DoEvents: Loop
        .document.write txt
    End With
End Sub

mromain · 3 Octobre 2023

Dju1 à dit:

Bonjour Romain,
merci pour le coup de main, ça fonctionne parfaitement pour le décrochage sur la droite, je vais avoir besoin d'ajouter d'autres espaces mais je devrais m'en sortir.
Ne me reste plus que la signature, mais là je t'avoue que ça devient complexe pour moi. Je mets le code si jamais quelqu'un peut prendre le temps de m'apporter un peu d'aide

Merci d'avance

VB:

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
  Dim Dat As Variant, C As Range, Txt As String, Col As Integer
  Dim L As Integer
  Dim objOL As Object, ObjMail As Object
  Dim oAttach As Object, ColAttach As Object
 
  Set objOL = CreateObject("Outlook.Application")
    Set ObjMail = objOL.CreateItem(0)
    Set ColAttach = ObjMail.attachments
    Set oAttach = ColAttach.Add("C:\Users\adv\Downloads\logo.jpg")
 
  If Sh.Name <> "LIEN WAZE" And Sh.Name <> "Config" Then
    Cancel = True
    If Target.Value = "*" Then
      If Target.Count > 1 Then Exit Sub
      If Target.Column <> 20 Or Target.Row < 9 Then Exit Sub
      Set olApp = CreateObject("Outlook.application")
      With Sh
        L = .[V:V].Find("*", , , , xlByRows, xlPrevious).Row + 1
        Col = Application.Match("PLANNING D'INTERVENTION", .[6:6], 0)
        For Each C In .Cells(9, Col).Resize(L, 5)
          If C = .Cells(Target.Row, 1) Then
            If .Cells(8, C.Column) < Dat Or Dat = "" Then
              Dat = .Cells(8, C.Column)
            End If
          End If
        Next C
      End With
      Txt = " <p> Bonjour, <p> Suite à notre entretien téléphonique je vous confirme le rendez-vous pour le début de votre chantier le <p> <b>"
      Txt = Txt & "<dd>" & Format(Dat, "dddd dd/mm/yyyy") & _
        " à partir de 7h30 </b> </dd> <p> A noter que nos poseurs sont habilités à réceptionner le chantier et à percevoir le solde restant dû, merci de " & _
        "prendre vos dispositions afin que cela soit respecté à la fin des travaux. "
      With ObjMail
        .Subject = "Confirmation de rendez-vous"
        .htmlBody = "<BODY><IMG src=cid:logo.jpg<\BODY>" & Txt
        .Recipients.Add Target.Offset(, -1)
        .display
       
      End With
     
    Set oAttach = Nothing
    Set ColAttach = Nothing
    Set ObjMail = Nothing
    Set objOL = Nothing
    End If
  End If
End Sub

Re-bonjour,

Pour ce, il te faut ajouter cette fonction à ton projet VBA :

VB:

Public Function UserSignatures() As Collection
Dim oFso As Object          'Scripting.FileSystemObject
Dim oCurFile As Object      'Scripting.File
Dim oRegExp As Object       'VBScript_RegExp_55.regExp
Dim oMatches As Object      'VBScript_RegExp_55.MatchCollection
Dim oMatch As Object        'VBScript_RegExp_55.Match
Dim pathSignatures As String
Dim relativePath As String
Dim absolutePath As String
Dim htmlSignature As String
 
    'initialisation
    Set UserSignatures = New Collection
    Set oFso = CreateObject("Scripting.FileSystemObject")
    Set oRegExp = CreateObject("vbscript.regexp")
    With oRegExp
        .Pattern = "<[^>]+src=""([^"">]+)"""
        .MultiLine = True
        .Global = True
    End With
 
    'boucler sur tous les fichiers du dossier %APPDATA%\Roaming\Microsoft\Signatures
    pathSignatures = Environ("APPDATA") & "\Microsoft\Signatures"
    For Each oCurFile In oFso.GetFolder(pathSignatures).Files
        'si le fichier est un .htm (signature)
        If LCase(oCurFile.Name) Like "*.htm" Then
            'récupérer le contenu html
            htmlSignature = oFso.OpenTextFile(oCurFile.Path, 1).ReadAll
            'remplacer les path relatifs en path absolus
            Set oMatches = oRegExp.Execute(htmlSignature)
            For Each oMatch In oMatches
                relativePath = oMatch.SubMatches(0)
                absolutePath = oFso.BuildPath(pathSignatures, relativePath)
                If oFso.FileExists(absolutePath) Then
                    htmlSignature = Replace(htmlSignature, "src=""" & relativePath & """", "src=""" & absolutePath & """")
                End If
            Next oMatch
            'ajouter la signature à la collection
            UserSignatures.Add htmlSignature, oFso.GetBaseName(oCurFile.Name)
        End If
    Next oCurFile
 
    Set oFso = Nothing
    Set oCurFile = Nothing
    Set oRegExp = Nothing
    Set oMatches = Nothing
    Set oMatch = Nothing
End Function

Et modifier ton code ainsi :

VB:

         .htmlBody = "<BODY><IMG src=cid:logo.jpg<\BODY>" & Txt & UserSignatures(1)

Ici, le 1 signifie "la première signature trouvée".
Si tu as plusieurs signatures, il te faudra peut-être adapter cet index.

A+

Dju1 · 3 Octobre 2023

re bonjour Romain,
parfait j'ai réussi à l'adapter, merci beaucoup pour ton aide

Microsoft 365 Mise en page mail/vba

Dju1

XLDnaute Occasionnel

mromain

Oneida

XLDnaute Impliqué

Pièces jointes

Dju1

XLDnaute Occasionnel

Dju1

XLDnaute Occasionnel

Oneida

XLDnaute Impliqué

mromain

XLDnaute Barbatruc

Dju1

XLDnaute Occasionnel

Dju1

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

mromain

XLDnaute Barbatruc

Dju1

XLDnaute Occasionnel

Discussions similaires