signature de outlook vba avec le nom de l'expéditeur

J'ai cherché beaucoup de questions, mais je n'ai pas pu find quelque chose qui correspond à ce que j'essaie de faire.

J'ai ce code Outlook pour envoyer ma fiche appelée par courrier électronique.

 Sub Mail_ActiveSheet() Dim FileExtStr As Ssortingng Dim FileFormatNum As Long Dim Sourcewb As Workbook Dim Destwb As Workbook Dim TempFilePath As Ssortingng Dim TempFileName As Ssortingng Dim OutApp As Object Dim OutMail As Object Dim sCC As Ssortingng Dim Signature As Ssortingng sCC = Range("copia").Value With Application .ScreenUpdating = False .EnableEvents = False End With Set Sourcewb = ActiveWorkbook Sheets("Pedidos").Copy Set Destwb = ActiveWorkbook ' Determine the Excel version, and file extension and format. With Destwb If Val(Application.Version) < 12 Then ' For Excel 2000-2003 FileExtStr = ".xls": FileFormatNum = -4143 Else ' For Excel 2007-2010, exit the subroutine if you answer ' NO in the security dialog that is displayed when you copy ' a sheet from an .xlsm file with macros disabled. If Sourcewb.Name = .Name Then With Application .ScreenUpdating = True .EnableEvents = True End With MsgBox "You answered NO in the security dialog." Exit Sub Else Select Case Sourcewb.FileFormat Case 51: FileExtStr = ".xlsx": FileFormatNum = 51 Case 52: If .HasVBProject Then FileExtStr = ".xlsm": FileFormatNum = 52 Else FileExtStr = ".xlsx": FileFormatNum = 51 End If Case 56: FileExtStr = ".xls": FileFormatNum = 56 Case Else: FileExtStr = ".xlsb": FileFormatNum = 50 End Select End If End If End With ' With Destwb.Sheets(1).UsedRange ' .Cells.Copy ' .Cells.PasteSpecial xlPasteValues ' .Cells(1).Select ' End With ' Application.CutCopyMode = False ' Save the new workbook, mail, and then delete it. TempFilePath = Environ$("temp") & "\" TempFileName = Sourcewb.Sheets("Consulta").Range("F2:G2").Value & " " _ & IIf(Len(Day(Now)) = 1, "0" & Day(Now), Day(Now)) & IIf(Len(Month(Now)) = 1, "0" & Month(Now), Month(Now)) & Year(Now) & Hour(Now) & Minute(Now) & Second(Now) Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) With Destwb .SaveAs TempFilePath & TempFileName & FileExtStr, _ FileFormat:=FileFormatNum On Error Resume Next On Error GoTo 0 ' Change the mail address and subject in the macro before ' running the procedure. With OutMail .to = "[email protected]" .CC = sCC .BCC = "" .Subject = "[PEDIDOS 019] " & TempFileName .HTMLBody = "<font face=""calibri"" color=""black""> Olá Natalia, <br>" .HTMLBody = .HTMLBody & " Por favor, fazer a requirejsição dos pedidos em anexo. <br>" & " Obrigado!<br>" & xxxxx & "</font>" .Attachments.Add Destwb.FullName ' You can add other files by uncommenting the following statement. '.Attachments.Add ("C:\test.txt") ' In place of the following statement, you can use ".Display" to ' display the mail. .SEND End With On Error GoTo 0 .Close SaveChanges:=False End With ' Delete the file after sending. Kill TempFilePath & TempFileName & FileExtStr Set OutMail = Nothing Set OutApp = Nothing With Application .ScreenUpdating = True .EnableEvents = True End With End Sub 

Comme vous pouvez le voir, le xxxxx dans la ligne ci-dessous représente ma signature que je souhaite recevoir mon e-mail (comme j'envoie) et l'écris (ou le nom et le nom de famille).

  .HTMLBody = "<font face=""calibri"" color=""black""> Olá Natalia, <br>" .HTMLBody = .HTMLBody & " Por favor, fazer a requirejsição dos pedidos em anexo. <br>" & " Obrigado!<br>" & xxxxx & "</font>" 

Donc, je suis vraiment ce que ce xxxxx est mon email , ou peut être mon nom , par exemple.

J'ai déjà vérifié la propriété MailItem.SenderName , mais je n'ai pas compris comment l'utiliser. Ceci est ma première fois par courrier électronique à l'aide de VBA afin que toutes les suggestions soient très appréciées.

SenderName ne sera disponible qu'après l'envoi du courrier.

 Option Explicit Sub Signature_Insert() Dim OutApp As Object Dim OutMail As Object Dim nS As Object Dim signature As Ssortingng Set OutApp = CreateObject("Outlook.Application") Set nS = OutApp.GetNamespace("mapi") Debug.Print nS.CurrentUser Debug.Print nS.CurrentUser.name ' default property Debug.Print nS.CurrentUser.Address Debug.Print nS.CurrentUser.AddressEntry.GetExchangeUser.PrimarySmtpAddress signature = nS.CurrentUser 'signature = nS.CurrentUser.Address Set OutMail = OutApp.CreateItem(0) With OutMail .To = "[email protected]" .CC = "sCC" .BCC = "" .Subject = "[PEDIDOS 019] " & "TempFileName" .HTMLBody = "<font face=""calibri"" color=""black""> Olá Natalia, <br>" .HTMLBody = .HTMLBody & " Por favor, fazer a requirejsição dos pedidos em anexo. <br>" & " Obrigado!<br>" & signature & "</font>" .Display End With ExitRoutine: Set OutApp = Nothing Set nS = Nothing Set OutMail = Nothing End Sub 

Essayez le code ci-dessous, cela fonctionnera

 .HTMLBody = .HTMLBody & " Por favor, fazer a requirejsição dos pedidos em anexo. <br>" & " Obrigado!<br>" & .To & "</font>" 

Remplacez simplement XXXXX par. Il appenda que " .To " dans votre signature