CODEWITHSUNDEEP
emailvbscriptoutlook
Johnnyand
Johnnyand

Reputation: 5

Outlook VBS oMail.to object that will print only the first name or address in the To line

I cobbled together a vbs macro to save bulk emails in .txt format with a file name that follows this format: [yymmdd].[hhmm].[sender].[recipient].[subject line].txt

The result is almost perfect, but the issue I am having is that the best term that I have found to print the "recipient" name is oMail.to, which will print every name/address in the To line for emails. I am trying to figure out a way to limit what is printed to just the first name or address that appears in the To line, so that if an email is sent to 3 addresses, the saved email only the displays one address in the subject line.

Ideally I would like the sender and recipient terms to only print the last names of known contacts or the email address for unknown contacts, but I'm not hopeful that there would be an easy solution to that problem.

Thanks in advance for any ideas!

Option Explicit
Public Sub SaveMessageAsTxt()
 Dim oMail As Outlook.MailItem
 Dim objItem As Object
 Dim sPath As String
 Dim dtDate As Date
 Dim sName As String
 Dim enviro As String
 enviro = CStr(Environ("USERPROFILE"))
 For Each objItem In ActiveExplorer.Selection
 If objItem.MessageClass = "IPM.Note" Then
 Set oMail = objItem
sName = oMail.SenderName & "." & oMail.To & "." & oMail.Subject
 ReplaceCharsForFileName sName, "-"
dtDate = oMail.ReceivedTime
 sName = Format(dtDate, "yymmdd.", vbUseSystemDayOfWeek, _
 vbUseSystem) & Format(dtDate, "hhnn", _
 vbUseSystemDayOfWeek, vbUseSystem) & "." & sName & ".txt"
sPath = enviro & "\Documents\Saved Emails\"
 Debug.Print sPath & sName
 oMail.SaveAs sPath & sName, olTXT
End If
 Next
End Sub

Private Sub ReplaceCharsForFileName(sName As String, _
 sChr As String _
)
 sName = Replace(sName, "'", sChr)
 sName = Replace(sName, "*", sChr)
 sName = Replace(sName, "/", sChr)
 sName = Replace(sName, "\", sChr)
 sName = Replace(sName, ":", sChr)
 sName = Replace(sName, "?", sChr)
 sName = Replace(sName, Chr(34), sChr)
 sName = Replace(sName, "<", sChr)
 sName = Replace(sName, ">", sChr)
 sName = Replace(sName, "|", sChr)
End Sub

Upvotes: 0

Views: 183

Answers (1)

Eugene Astafiev
Eugene Astafiev

Reputation: 49395

Use the Recipients property of the MailItem class which returns a Recipients collection that represents all the recipients for the Outlook item. Use Recipients (index), where index is the name or index number, to return a single Recipient object. The name can be a string representing the display name, the alias, or the full SMTP email address of the recipient.

Accessing the AddressEntry property forces resolution of an unresolved recipient name. If the name cannot be resolved, an error is returned. If the recipient is resolved, the Resolved property is true. Then you can use the Address and Name properties.

Upvotes: 1

Related Questions