![](/img/trans.png)
[英]How to save Outlook emails on the basis of subject and sender name, using VBA?
[英]vba outlook signature with sender name
我搜索了很多問題,但找不到與我要執行的操作匹配的內容。
我有此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發送電子郵件,因此任何建議將不勝感激。
試試下面的代碼,這將工作
.HTMLBody = .HTMLBody & " Por favor, fazer a requisição dos pedidos em anexo. <br>" & " Obrigado!<br>" & .To & "</font>"
只需將XXXXX替換為.To,它將在您的簽名中添加“ .To ”
發送郵件之前,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.