vba outlook簽名與發件人姓名

Question

我已經搜索了很多問題，但找不到與我想要做的事情相匹配的內容。

我有這個Outlook代碼通過電子郵件發送我的工作表Pedidos。下面

Sub Mail_ActiveSheet() 

    Dim FileExtStr As String 
    Dim FileFormatNum As Long 
    Dim Sourcewb As Workbook 
    Dim Destwb As Workbook 
    Dim TempFilePath As String 
    Dim TempFileName As String 
    Dim OutApp As Object 
    Dim OutMail As Object 
    Dim sCC As String 
    Dim Signature As String 

    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 = "example@example.com" 
      .CC = sCC 
      .BCC = "" 
      .Subject = "[PEDIDOS 019] " & TempFileName 
      .HTMLBody = "<font face=""calibri"" color=""black""> Olá Natalia, <br>" 
      .HTMLBody = .HTMLBody & " Por favor, fazer a requisiçã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 

正如你所看到的，在該行的xxxxx代表我的簽名，我想我的電子郵件（如我送），並寫有（或名稱和姓氏）。

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

所以，我真的什麼這個xxxxx是我的電子郵件，也許我的名字，例如。

我已經檢查了MailItem.SenderName屬性，但我不明白如何使用它。這是我第一次使用VBA發送電子郵件，因此任何建議都將受到高度讚賞。

Answer 1

發送者姓名將無法使用，直到郵件發送。

Option Explicit 

Sub Signature_Insert() 

    Dim OutApp As Object 
    Dim OutMail As Object 
    Dim nS As Object 

    Dim signature As String 

    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 = "example@example.com" 
     .CC = "sCC" 
     .BCC = "" 
     .Subject = "[PEDIDOS 019] " & "TempFileName" 
     .HTMLBody = "<font face=""calibri"" color=""black""> Olá Natalia, <br>" 
     .HTMLBody = .HTMLBody & " Por favor, fazer a requisiçã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 

Answer 2

嘗試下面的代碼，這將工作

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

通過。爲只需更換XXXXX它會添加「。要」在您的簽名