Hi All,
I've spent hours messing around with this now and just cant work it out and google is not getting me any closer
I've got an excel module which saves my workbook exports it to a pdf and then generates an email with the pdf attached.
Where I'm stuck is setting a follow up reminder for myself as the sender. I should point out that um using office 2010 but there are other people who will be using this from different versions so need to late bind everything.
In outlook when creating a new email if i click follow-up and select custom I have the option to "Flag for Me" and set a reminder. How can I add this to my current module?...
I've taken bits and pieces of VBA from all over the internet to make this so please excuse how messy it probably is.
If anyone can help it would be greatly appreciated!!!
Cheers,
Lee.
I've spent hours messing around with this now and just cant work it out and google is not getting me any closer
I've got an excel module which saves my workbook exports it to a pdf and then generates an email with the pdf attached.
Where I'm stuck is setting a follow up reminder for myself as the sender. I should point out that um using office 2010 but there are other people who will be using this from different versions so need to late bind everything.
In outlook when creating a new email if i click follow-up and select custom I have the option to "Flag for Me" and set a reminder. How can I add this to my current module?...
I've taken bits and pieces of VBA from all over the internet to make this so please excuse how messy it probably is.
Code:
Sub SaveFileAs()
Dim CurrFile As String
Dim WasSaved As Boolean
Dim ret As Boolean
Dim IsCreated As Boolean
Dim i As Long
Dim PdfFile As String, Title As String, mailBody As String
Dim OutlApp As Object
Dim cc_emailRng As Range, cl As Range
Set cc_emailRng = Range("cc_emails")
For Each cl In cc_emailRng
scc = scc & ";" & cl.Value
Next
scc = Mid(scc, 2)
On Error Resume Next
WasSaved = False
On Error Resume Next
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path & "\" & "RFI - " & Range("D9").Value & "_" & Range("H4").Value & ".xls"
If Err.Number = 0 Then
WasSaved = True
End If
On Error Resume Next
If WasSaved = True Then
CurrFile = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
Else
Err.Clear
ret = Application.Dialogs(xlDialogSaveAs).Show
If ret = True Then
'saved with some name
WasSaved = True
End If
End If
On Error Resume Next
If WasSaved = False Then
MsgBox "Not Saved!" & vbNewLine & vbNewLine _
& "If you are experiencing any problems " & vbNewLine & _
"please contact ...", vbExclamation
End If
Title = "Request For Information - " & Range("D9").Value & "_" & Range("H4").Value
' Define PDF filename
PdfFile = ActiveWorkbook.FullName
i = InStrRev(PdfFile, ".")
If i > 1 Then PdfFile = Left(PdfFile, i - 1)
PdfFile = PdfFile & ".pdf"
' Export activesheet as PDF
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
' Use already open Outlook if possible
On Error Resume Next
Set OutlApp = GetObject(, "Outlook.Application")
If Err Then
Set OutlApp = CreateObject("Outlook.Application")
IsCreated = True
End If
If ActiveSheet.Shapes("Check Box 1").ControlFormat.Value = 1 Then
mailBody = "Please note: Cost/Time Implications do apply. <br>"
Else: mailBody = " "
End If
If WasSaved = True Then
MsgBox "Excel Workbook Saved as: " & vbNewLine & _
ActiveWorkbook.FullName & vbNewLine & vbNewLine & _
"PDF Saved as: " & vbNewLine & _
PdfFile & vbNewLine, , "Files Saved"
End If
On Error Resume Next
OutlApp.Visible = True
On Error GoTo 0
' Prepare e-mail with PDF attachment
With OutlApp.CreateItem(0)
' Prepare e-mail
.Display
signiture = .HTMLBody
'.SentOnBehalfOfName = Range("Originator").Value & "<" & Range("globalEmail") & ">"
.Subject = Title
.To = Range("email").Value ' <-- Put email of the recipient here
.CC = scc ' <-- Put email of 'copy to' recipient here
.HTMLBody = "<H3></H3>" & _
"Attention: " & Range("D8").Value & "<br><br>" _
& "Please find Request for Information Number " & Range("H4").Value & " attached for " & Range("D9").Value & "<br><br>" _
& "Originator: " & Range("Originator").Value & "<br><br>" _
& mailBody & "<br><br>" _
& "Please Return Response To: ... Pty Ltd<br>" _
& "Response Required by: " & Range("H8").Value & "<br>" _
& "For the Attention of: " & Range("globalAttention").Value & "<br>" _
& "Fax: " & Range("globalFax").Value & "<br>" _
& "Telephone: " & Range("globalTelephone").Value & "<br>" _
& "Email: " & Range("globalEmail").Value & "<br>" _
& signiture
.Attachments.Add PdfFile
.FlagStatus = olFlagMarked
.FlagRequest = "Follow up"
.FlagDueBy = Format(DateAdd("d", -0, CDate(Range("H8").Value) & " 09:30 AM"))
' Try to send
'.Send
On Error Resume Next
.Display
Application.Visible = True
If Err Then
MsgBox "E-mail was not sent", vbExclamation
Else
'MsgBox "E-mail successfully sent", vbInformation
End If
On Error GoTo 0
End With
If WasSaved = False Then
Kill PdfFile ' Delete PDF file
End If
' Quit Outlook if it was created by this code
'If IsCreated Then OutlApp.Quit
' Release the memory of object variable
Set OutlApp = Nothing
End SubIf anyone can help it would be greatly appreciated!!!
Cheers,
Lee.
