NVRensburg
Board Regular
- Joined
- Jul 1, 2014
- Messages
- 113
- Office Version
- 365
- 2016
- Platform
- Windows
Hi there
I've got a VBA that I use for multiple sheets, and I want to use the same one with some changes for a new sheet I'm working in. Is there someone who can please help me modify the code as I've tried but I'm not winning.
So this is the VBA that's currently working (I've edited the email addresses for privacy)
Sub wfpemail()
Dim IsCreated As Boolean
Dim i As Long
Dim PdfFile As String, Title As String
Dim OutlApp As Object
' Not sure for what the Title is
Title = Range("$C$2")
' Define PDF filename
PdfFile = ActiveWorkbook.FullName
i = InStrRev(PdfFile, ".")
If i > 1 Then PdfFile = Left(PdfFile, i - 1)
PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
' Export activesheet as PDF
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
' Export activesheet as PDF
With ActiveSheet.Range("A8:AA188")
.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
OutlApp.Visible = True
On Error GoTo 0
' Prepare e-mail with PDF attachment
With OutlApp.CreateItem(0)
' Prepare e-mail
.Subject = Range("$C$2")
.To = Range("$C$3")
.BCC = "name.surname@abccompany.com" ' <-- Put email of 'copy to' recipient here
.Body = "Hi," & Range("B2") & vbLf _
& " " & vbLf _
& "Please find attached the latest version of the Bettabuilt Workforce Planner." & vbLf & vbLf _
& "Should there be any changes from your side, or if something is incorrect, please reply to this email with the required changes so that I can edit the worksheet from my side." & vbLf _
& " " & vbLf _
& "Kind Regards," & vbLf _
& "Name Surname," & vbLf _
& "Company Name" & vbLf _
& " " & vbLf & vbLf
.Attachments.Add PdfFile
.SentOnBehalfOfName = "otheremail@companyname.com"
' Try to send
On Error Resume Next
.Send
Application.Visible = True
If Err Then
MsgBox "E-mail was not sent", vbExclamation
Else
MsgBox "E-mail successfully sent to CONSTRUCTION MANAGER", vbInformation
End If
On Error GoTo 0
End With
' Delete PDF file
Kill PdfFile
' Quit Outlook if it was created by this code
If IsCreated Then OutlApp.Quit
' Release the memory of object variable
Set OutlApp = Nothing
End Sub
So basically what I want to change is:
Stop at outlook so I can copy a selection of cells and add it to the body of the email and then press send and all the email addresses etc are already inserted (if that makes sense?)
I've got a VBA that I use for multiple sheets, and I want to use the same one with some changes for a new sheet I'm working in. Is there someone who can please help me modify the code as I've tried but I'm not winning.
So this is the VBA that's currently working (I've edited the email addresses for privacy)
Sub wfpemail()
Dim IsCreated As Boolean
Dim i As Long
Dim PdfFile As String, Title As String
Dim OutlApp As Object
' Not sure for what the Title is
Title = Range("$C$2")
' Define PDF filename
PdfFile = ActiveWorkbook.FullName
i = InStrRev(PdfFile, ".")
If i > 1 Then PdfFile = Left(PdfFile, i - 1)
PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
' Export activesheet as PDF
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
' Export activesheet as PDF
With ActiveSheet.Range("A8:AA188")
.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
OutlApp.Visible = True
On Error GoTo 0
' Prepare e-mail with PDF attachment
With OutlApp.CreateItem(0)
' Prepare e-mail
.Subject = Range("$C$2")
.To = Range("$C$3")
.BCC = "name.surname@abccompany.com" ' <-- Put email of 'copy to' recipient here
.Body = "Hi," & Range("B2") & vbLf _
& " " & vbLf _
& "Please find attached the latest version of the Bettabuilt Workforce Planner." & vbLf & vbLf _
& "Should there be any changes from your side, or if something is incorrect, please reply to this email with the required changes so that I can edit the worksheet from my side." & vbLf _
& " " & vbLf _
& "Kind Regards," & vbLf _
& "Name Surname," & vbLf _
& "Company Name" & vbLf _
& " " & vbLf & vbLf
.Attachments.Add PdfFile
.SentOnBehalfOfName = "otheremail@companyname.com"
' Try to send
On Error Resume Next
.Send
Application.Visible = True
If Err Then
MsgBox "E-mail was not sent", vbExclamation
Else
MsgBox "E-mail successfully sent to CONSTRUCTION MANAGER", vbInformation
End If
On Error GoTo 0
End With
' Delete PDF file
Kill PdfFile
' Quit Outlook if it was created by this code
If IsCreated Then OutlApp.Quit
' Release the memory of object variable
Set OutlApp = Nothing
End Sub
So basically what I want to change is:
Stop at outlook so I can copy a selection of cells and add it to the body of the email and then press send and all the email addresses etc are already inserted (if that makes sense?)