Hi Peeps,
I'm stuck again and need the brains-trust!
I am sending an email from Excel. At the moment I am pasting a file address and name into a cell and completing the email. I would like VBA to be able to call the "Insert File" pop up box so I can use the directory to select the file to attach. Is this possible?
O4 & O5 are the cells holding the attachments.
My Code so far -
Sub Sent_Test_Email()
On Error GoTo ErrHandler
' SET Outlook APPLICATION OBJECT.
Dim objOutlook As Object
Set objOutlook = CreateObject("Outlook.Application")
' CREATE EMAIL OBJECT.
Dim objEmail As Object
Set objEmail = objOutlook.CreateItem(olMailItem)
With objEmail
.to = ActiveCell.Offset(, 6).Value
.CC = ActiveCell.Offset(, 7).Value
.Subject = ActiveCell.Offset(, 8).Value
.Body = ActiveCell.Offset(, 9).Value
.Attachments.Add Range("O4").Value
.Attachments.Add Range("O5").Value
'.HTMLBody = strbody & "<br>" & Signature
'.HTMLBody = "<HTML><BODY><span style=""color:#80BFFF"">Font Color</span style=""color:#80BFFF""> <br>the <b>bold text</b> here.</br> <br><u>New line with underline</u></br><br><p style='font-family:calibri;font-size:25'>Font size</br></p></BODY></HTML>"
.Display ' Display the message in Outlook.
End With
' CLEAR.
Set objEmail = Nothing: Set objOutlook = Nothing
ErrHandler:
'
ActiveCell.Offset(, 1).Select
ActiveCell.FormulaR1C1 = "=TODAY()"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
'ActiveCell.Offset(0, 1).Select
' Down - Across
End Sub
Thanks for any help.
I'm stuck again and need the brains-trust!
I am sending an email from Excel. At the moment I am pasting a file address and name into a cell and completing the email. I would like VBA to be able to call the "Insert File" pop up box so I can use the directory to select the file to attach. Is this possible?
O4 & O5 are the cells holding the attachments.
My Code so far -
Sub Sent_Test_Email()
On Error GoTo ErrHandler
' SET Outlook APPLICATION OBJECT.
Dim objOutlook As Object
Set objOutlook = CreateObject("Outlook.Application")
' CREATE EMAIL OBJECT.
Dim objEmail As Object
Set objEmail = objOutlook.CreateItem(olMailItem)
With objEmail
.to = ActiveCell.Offset(, 6).Value
.CC = ActiveCell.Offset(, 7).Value
.Subject = ActiveCell.Offset(, 8).Value
.Body = ActiveCell.Offset(, 9).Value
.Attachments.Add Range("O4").Value
.Attachments.Add Range("O5").Value
'.HTMLBody = strbody & "<br>" & Signature
'.HTMLBody = "<HTML><BODY><span style=""color:#80BFFF"">Font Color</span style=""color:#80BFFF""> <br>the <b>bold text</b> here.</br> <br><u>New line with underline</u></br><br><p style='font-family:calibri;font-size:25'>Font size</br></p></BODY></HTML>"
.Display ' Display the message in Outlook.
End With
' CLEAR.
Set objEmail = Nothing: Set objOutlook = Nothing
ErrHandler:
'
ActiveCell.Offset(, 1).Select
ActiveCell.FormulaR1C1 = "=TODAY()"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
'ActiveCell.Offset(0, 1).Select
' Down - Across
End Sub
Thanks for any help.
