Modify VBA

NVRensburg

Board Regular
Joined
Jul 1, 2014
Messages
113
Office Version
  1. 365
  2. 2016
Platform
  1. 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?)
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
Not sure what you mean by 'stop at outlook' but maybe just changing .Send to .Display will give you what you want.
I forgot to mention: please post code within code tags (vba button on posting toolbar) to maintain indentation and improve readability.
 
Upvote 0
Solution
Not sure what you mean by 'stop at outlook' but maybe just changing .Send to .Display will give you what you want.
I forgot to mention: please post code within code tags (vba button on posting toolbar) to maintain indentation and improve readability.

So I just want the code to stop after this part so I can manually add info to the body and then press send manually

.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
 
Upvote 0
That message is because your sub has to end with End Sub. It seems that you didn't change the one line like I suggested, but you have not shown what you have now.
 
Upvote 0
VBA Code:
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 = "[EMAIL]name.surname@abccompany.com[/EMAIL]" ' <-- 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 = "[EMAIL]otheremail@companyname.com[/EMAIL]"
' 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
 
Upvote 0
Did that work?
Did what work? Your post? Your code? I tried running your code with some edits (such as not providing values for .To and such) but your On Error statements are hiding issues, at least for me. I suggest you comment out those lines and see what happens. I did but it's a bit buggy in the workbook I used. Maybe my workbook code project is getting corrupted.

In the meantime, based on the code you posted you have not made the change I told you to make so that you could edit the email. Note that currently, if I display the email, close it and don't send it your messages still indicates the email was sent. You might want to fix that also.
Not .Send - .Display instead as I mentioned.
 
Upvote 0
Not sure what you mean by 'stop at outlook' but maybe just changing .Send to .Display will give you what you want.
I forgot to mention: please post code within code tags (vba button on posting toolbar) to maintain indentation and improve readability.
Sorry I missed this instruction above during my crazy few weeks. I've managed to get it to work now thank you so much for your time and help with this!
 
Upvote 0

Forum statistics

Threads
1,224,819
Messages
6,181,153
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top