I have written an email program to send newest files. Is there a code to convert it to HTML. See code below
Sub SendNewestFiles()
Dim objMail As Outlook.MailItem
Dim fldName As String
Dim sName As String
fldName = "\\mgamain\DATA\General\TINA FILES\INVOICES TO EMAIL\"
i = 0
sName = Dir(fldName)
Do While Len(sName) > 0
Set objMail = Application.CreateItem(olMailItem)
With objMail
.Subject = "MGA INTERNATIONAL INVOICES"
.BodyFormat = olFormatPlain
.Attachments.Add (fldName & sName)
.Display ' .send
End With
sName = Dir
i = i + 1
Loop
End Sub
Bodyformat should be olFormatHTML if you're wanting a html body.
The options are:
olFormatHTML,
olFormatPlain,
olFormatRichText,
olFormatUnspecified
https://learn.microsoft.com/en-us/previous-versions/office/developer/office-2003/aa211430(v%3Doffice.11)
Related
I'd like to create an email with an attachment where there is a date in the name of the file.
I'd be composing this email generally Monday for a file name that's dated for the previous Friday.
File name to be attached: 20210205 - XYZ.pdf
Here's the code I have so far:
Sub WMSCL()
LastFridayDate = Date - Weekday(Date, vbSaturday)
Dim oMsg As Outlook.MailItem
Set oMsg = Application.CreateItem(olMailItem)
With oMsg
.To =
.CC =
.Subject =
.Attachments.Add "C:\filepath\LastFriday & "- XYZ.pdf"
.HTMLBody =
.Display
End With
End Sub
Looks like you just needed to format the date so it is in the correct date format as your file path and concatenate the date to the file path correctly.
Sub WMSCL()
Dim lastFridayDate As Variant
Dim filePath As String
Dim oMsg As Outlook.MailItem
Set oMsg = Application.CreateItem(olMailItem)
lastFridayDate = Date - Weekday(Date, vbSaturday)
lastFridayDate = Format(lastFridayDate, "yyyymmdd")
filePath = "C:\filepath\"
filePath = filePath & lastFridayDate & " - XYZ.pdf"
With oMsg
.To =
.CC =
.Subject =
.Attachments.Add filePath
.HTMLBody =
.Display
End With
'Cleanup
Set oMsg = Nothing
End Sub
I am trying to create an email and populate multiple recipients based off a listbox.
I tried putting the list box column reference in the ".To" line but it gives a null error.
I found code that should loop through the listbox values but it is not populating any recipients.
Public Sub cmdEmailContact_Click()
Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Dim strPath As String
Dim strFilter As String
Dim strFile As String
Dim strFileEnd As String
Dim strEmailRecipients As String
strPath = "C:\Users\username\Desktop\Invoice Test\GCX"
strFilter = Me.txtInvNum
strFileEnd = ".pdf"
strFile = Dir(strPath & strFilter & strFileEnd)
strEmailRecipients = ""
For N = 0 To Me.lstContacts.ListCount - 1
If Me.lstContacts.Selected(N) = True Then
strEmailRecipients = strEmailRecipients & "; " & Me.lstContacts.Column(3, N)
End If
Next N
strEmailRecipients = Mid(strEmailRecipients, 3)
If strFile <> "" Then
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
With MailOutLook
.BodyFormat = olFormatRichText
.To = strEmailRecipients
''.cc = ""
''.bcc = ""
.Subject = "text here"
.SentOnBehalfOfName = "emailname"
.HTMLBody = "text here"
.Attachments.Add (strPath & strFilter & strFileEnd)
'.Send
.Display
End With
Else
MsgBox "No file matching " & strPath & strFilter & strFileEnd & " found." & vbCrLf & _
"Process has been stopped."
Exit Sub
End If
End Sub
I expect strEmailRecipients to equal a semi-colon separated list of email addresses based off the listbox. There are no error messages.
Rather than building a semi-colon delimited string to populate the To property of the MailItem object, you may instead want to modify the contents of the Recipients collection when adding recipients (independent of the recipient type) to a MailItem object.
Adding an item to the Recipients collection using the Add method will yield a Recipient object, which has a Type property which may be used to designate the recipient as either to, cc, or bcc by setting the property to olTo, olCC, or olBCC (or 1, 2, or 3 if using late binding).
Hence the construction of the email might become something along the lines of the following:
Dim idx
With MailOutLook
With .Recipients
For Each idx In lstContacts.ItemsSelected
With .Add(lstContacts.ItemData(idx))
.Type = olTo
End With
Next idx
End With
.BodyFormat = olFormatRichText
' ... etc.
End With
.Body of Mailitem is not returning anything
I am using the entryID to get access to the inbound email and set the object using Application.Session.GetItemFromID
strID = olitem.EntryID
Set olitem = Application.Session.GetItemFromID(strID)
Once I set olitem
Set olitem = Application.Session.GetItemFromID(strID)
it shows the email has been accessed, but when sText = olitem.Body is run stext ends up empty.
Here is the entire code that is fired from an Outlook Rule.
Sub ParseEPDMRequest(olitem As Outlook.MailItem)
Dim arr() As String
Dim ECONum As String
Dim ReqID As String
Dim sText As String
Dim strID As String
strID = olitem.EntryID
Set olitem = Application.Session.GetItemFromID(strID)
sText = olitem.Body
arr = Split(olitem.Body, ":")
arr = Split(arr(15), " ")
ECONum = GetECONum(arr(8))
sText = olitem.Subject
ReqID = GetReqId(sText)
Call TEAMtoEPDMPush(ECONum & ".xml", ReqID)
End Sub
Under certain circumstances the message can have no plain text body. You have to check the format of the body (see BodyFormat property):
strID = olitem.EntryID
Set olitem = Application.Session.GetItemFromID(strID)
If olitem.BodyFormat=OlBodyFormat.olFormatPlain Then
sText = olitem.Body
...
ElseIf olitem.BodyFormat=OlBodyFormat.olFormatHTML Then
...
I am trying to add an attachment functionality to my emails. My email code is working however the attachments are being sent as ATT00001.bin files.
The variable Forms![frmMain]!TabCtl54.Pages("page56").Controls("subtblcontent").Form![attachmentlnk] is a textbox on a form which is where I would put my file name.
attachmentlnkvar = "file:///C:/Users/desktopname/Desktop/" & Forms![frmMain]!TabCtl54.Pages("page56").Controls("subtblcontent").Form![attachmentlnk] & ".pdf"
With cdomsg
.To = emailstr
.FROM = fromemailstr
.subject = Forms!frmMain.txtSubject
.Attachments.Add attachmentlnkvar
.HTMLBody = strHTML
.Send
End With
Set cdomsg = Nothing
Is there a way I can send my files as pdfs?
I am happy to share with you the function which I use to sent all my emails:
Public Sub SendMessage(Optional SubjectText = "", Optional BodyText = "", Optional AttachmentPath = "", Optional sendTo = "", Optional sendCC = "", Optional DeliveryConfirmation = True, Optional DisplayDoNotAutoSend = True, Optional SendHighPriority = True, Optional UseHTML = True)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim MultipleAttachmentPath As String
Dim CurrentAttachment As Variant
Dim aAtachments() As String
On Error GoTo ErrorMsgs
DoCmd.Hourglass True
' Create the Outlook session.
Set objOutlook = New Outlook.Application
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
If UseHTML Then
.BodyFormat = olFormatHTML
End If
If Not isnull(sendTo) And InStr(sendTo, "#") > 0 Then
.To = sendTo
End If
If Not isnull(sendCC) And InStr(sendCC, "#") > 0 Then
.CC = sendCC
End If
.Subject = SubjectText
If UseHTML Then
.HTMLBody = "<div style='font-family:Calibri,sans-serif'>" & BodyText & GetThankYouSignature & "</div>"
Else
.Body = BodyText & vbCrLf & GetUserFullNameInASCIIText & vbCrLf & vbCrLf
End If
If SendHighPriority Then
.Importance = olImportanceHigh 'High importance
End If
If DeliveryConfirmation Then
.OriginatorDeliveryReportRequested = True
.ReadReceiptRequested = True
End If
On Error Resume Next
If AttachmentPath <> "" Then
' Add attachments to the message.
If Not IsMissing(AttachmentPath) And InStr(AttachmentPath, ";") = 0 Then
Set objOutlookAttach = .Attachments.add(AttachmentPath)
ElseIf Not IsMissing(AttachmentPath) And InStr(AttachmentPath, ";") > 0 Then
aAtachments = Split(AttachmentPath, ";")
For Each CurrentAttachment In aAtachments
.Attachments.add (CurrentAttachment)
Next
End If
End If
On Error GoTo ErrorMsgs
End With
If DisplayDoNotAutoSend Or isnull(sendTo) Then
objOutlookMsg.Display
Else
objOutlookMsg.Send
End If
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
Set objOutlookRecip = Nothing
Set objOutlookAttach = Nothing
DoCmd.Hourglass False
Exit Sub
ErrorMsgs:
DoCmd.Hourglass False
If Err.Number = "287" Then
MsgBox "You clicked No to the Outlook security warning. " & _
"Rerun the procedure and click Yes to access e-mail" & _
"addresses to send your message. For more information," & _
"see the document at http://www.microsoft.com/office" & _
"/previous/outlook/downloads/security.asp. "
Else
Call LogError(Err.Number, Err.Description, "SystemUtilities", "SendMessage")
Resume Next
Resume
End If
End Sub
The variable AttachmentPath can contain multiple paths to attachments delimited by ";"
Don't use file:// etc., just the path. And backslashes.
attachmentlnkvar = "C:\Users\desktopname\Desktop\" & Forms![frmMain]!TabCtl54.Pages("page56").Controls("subtblcontent").Form![attachmentlnk] & ".pdf"
Instead of .Attachments.Add attachmentlnkvar have you tried .AddAttachment attachmentlnkvar? That's what I use to send PDF reports via an SMTP server instead of Outlook.
The problem is with your SMTP server. Try putting the attachment after the body to avoid this problem. If that doesn't work, try sending the message as plain text instead of HTML using:
.TextBody = bodyText
EXAMPLE:
attachmentlnkvar = "C:/Users/desktopname/Desktop/" & Forms![frmMain]!TabCtl54.Pages("page56").Controls("subtblcontent").Form![attachmentlnk] & ".pdf"
With cdomsg
.To = emailstr
.FROM = fromemailstr
.Subject = Forms!frmMain.txtSubject
.HTMLBody = strHTML
.AddAttachment attachmentlnkvar
.Send
End With
Set cdomsg = Nothing
EXPLANATION:
https://kb.mit.edu/confluence/pages/viewpage.action?pageId=4981187
My folder is called "Request Mailbox" in Outlook
How can I get a list of all mailitems in that folder
To get list of MailItems, you can simply do this
MailItem list will be displayed as Email
Option Explicit
Sub MailItems()
Dim olNamespace As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim olItem As Outlook.MailItem
Set olNamespace = Application.GetNamespace("MAPI")
Set olFolder = olNamespace.GetDefaultFolder(olFolderInbox).Folders("Request Mailbox")
Set olItem = Application.CreateItem(olMailItem) ' Creat EMail
With olItem
For Each olItem In olFolder.Items
Debug.Print olItem.Subject ' Print to immediate window
.body = .body & olItem.Subject & vbCrLf ' Print to Email
Debug.Print olItem.SenderName
.body = .body & olItem.SenderName & vbCrLf
Debug.Print olItem.ReceivedTime
.body = .body & olItem.ReceivedTime & vbCrLf & vbCrLf
Next ' vbCrLf = vb: Visual Basic Cr: Carriage Return Lf: LineFeed
.Subject = "Mail Items" ' Subject
.Display ' Display Msg
End With
End Sub
For Shared Folder Try this
Option Explicit
Sub ShareMailItems()
Dim olNamespace As Outlook.NameSpace
Dim olShareName As Outlook.Recipient
Dim olShareInbox As Outlook.Folder
Dim olItem As Outlook.MailItem
Set olNamespace = Application.GetNamespace("MAPI")
Set olShareName = olNamespace.CreateRecipient("0m3r#email.com") '// Owner's email address
Set olShareInbox = olNamespace.GetSharedDefaultFolder( _
olShareName, olFolderInbox).Folders("Request Mailbox") '// FolderName
Set olItem = Application.CreateItem(olMailItem) ' Creat EMail
With olItem
For Each olItem In olShareInbox.Items
Debug.Print olItem.Subject ' Print to immediate window
.body = .body & olItem.Subject & vbCrLf ' Print to Email
Debug.Print olItem.SenderName
.body = .body & olItem.SenderName & vbCrLf
Debug.Print olItem.ReceivedTime
.body = .body & olItem.ReceivedTime & vbCrLf & vbCrLf
Next ' vbCrLf = vb: Visual Basic Cr: Carriage Return Lf: LineFeed
.Subject = "Mail Items" ' Subject
.Display ' Display
End With
End Sub
For a delegate mailbox already open in Outlook, use Application.Session.Folders.("TheDelegateMialboxName#YourCompany.com").Folders("TheFolderName")