[英]vba outlook signature with sender name
I've searched for a lot of questions but I couldn't find something that matches what I'm trying to do. 我搜索了很多问题,但找不到与我要执行的操作匹配的内容。
I have this Outlook code to send my sheet called Pedidos
via e-mail. 我有此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
As you can see, the xxxxx
in the line below represents my signature which I want to get my e-mail (as I'm sending) and write it there (or the name and lastname). 如您所见,下面一行中的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>"
So I really what this xxxxx
to be my-email , or maybe my name , for example. 所以我确实将此xxxxx
用作我的电子邮件 ,或者也许是我的名字 。
I've already checked the MailItem.SenderName property, but I didn't understand how to use it. 我已经检查了MailItem.SenderName属性,但是我不知道如何使用它。 This is my first time e-mailing using VBA so any suggestions will be highly appreciated. 这是我第一次使用VBA发送电子邮件,因此任何建议将不胜感激。
Try the below code this will work 试试下面的代码,这将工作
.HTMLBody = .HTMLBody & " Por favor, fazer a requisição dos pedidos em anexo. <br>" & " Obrigado!<br>" & .To & "</font>"
Just replace XXXXX by .To it will add that " .To " in your signature 只需将XXXXX替换为.To,它将在您的签名中添加“ .To ”
SenderName will not be available until the mail is sent. 发送邮件之前,SenderName将不可用。
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.