As part of my internship at a company, I have been asked to automate an email we send to our manager every week in outlook. The email contains a bunch of data, texts, tables and graphs from Excel. The only way I see to make this work, is using VBA's. However there is one small problem, even though I can use R, Stata and other programs, I do not know how to use VBA's. So I was wondering if anyone could help me with this:
I've got six different Excel worksheets in one workbook. Before combining data and stuff from every worksheet, I was able to do the following:
I created a code that saves one of the six sheets as a pdf-file in a specific place on my laptop:
Function SanitizeFileName(fileName As String) As String
Dim invalidChars As Variant
Dim char As Variant
Dim sanitized As String
invalidChars = Array("/", "\", ":", "*", "?", """", "<", ">", "|")
sanitized = fileName
For Each char In invalidChars
sanitized = Replace(sanitized, char, "_") ' Replace invalid chars with underscore
Next char
SanitizeFileName = sanitized
End Function
Sub SaveAsPDF()
Dim fileName As String
Dim filePath As String
Dim ws As Worksheet
Dim dateStamp As String
' Generate a date stamp for the filename (YYYY-MM-DD)
dateStamp = Format(Now, "yyyy-mm-dd")
' Get the name from cell A1 and sanitize it, appending the date stamp
fileName = SanitizeFileName(Range("A1").Value & "Check_" & dateStamp & ".pdf")
' Set the file path
filePath = "(Private)"
' Set the worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")
' Check if the directory exists
If Dir(filePath, vbDirectory) = "" Then
MsgBox "The specified directory does not exist.", vbExclamation
Exit Sub
End If
' Set font size to 16 for the entire worksheet
ws.Cells.Font.Size = 16
' Ensure text wrapping is enabled
ws.Cells.WrapText = True
' AutoFit all columns to adjust to content
ws.Columns.AutoFit
' Set the page layout settings
With ws.PageSetup
.Orientation = xlPortrait ' Use portrait orientation
.PaperSize = xlPaperA4 ' Set paper size to A4
.FitToPagesWide = 1 ' Fit to one page wide
.FitToPagesTall = False ' Allow multiple pages if necessary
.Zoom = False ' Disable zoom to use FitToPages settings
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0.5)
.LeftMargin = Application.InchesToPoints(0.5)
.RightMargin = Application.InchesToPoints(0.5)
End With
' Export the worksheet to PDF
On Error GoTo ErrorHandler ' Set error handling
ws.ExportAsFixedFormat Type:=xlTypePDF, _
IgnorePrintAreas:=False, _
fileName:=filePath & fileName
MsgBox "PDF file saved successfully as " & fileName, vbInformation
Exit Sub
ErrorHandler:
MsgBox "Error saving PDF: " & Err.Description, vbCritical
End Sub
Then I created a code that creates a mail in outlook with a piece of text and the pdf I created with the other code as an attachment in the mail:
Sub CreateEmailWithPDFAttachment()
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim filePath As String
Dim fileName As String
Dim fullFilePath As String
Dim dateStamp As String
filePath = "Private"
dateStamp = Format(Now, "yyyy-mm-dd")
fileName = SanitizeFileName(Range("A1").Value & "Check_" & dateStamp & ".pdf")
fullFilePath = filePath & fileName
If Dir(fullFilePath) = "" Then
MsgBox "The file does not exist: " & fullFilePath, vbExclamation
Exit Sub
End If
On Error Resume Next
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
On Error GoTo 0
If OutlookMail Is Nothing Then
MsgBox "Outlook is not available.", vbExclamation
Exit Sub
End If
With OutlookMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Your PDF Attachment"
.Body = "Please find the attached PDF document."
.Attachments.Add fullFilePath
.Display
End With
MsgBox "Email created with attachment: " & fullFilePath
End Sub
Function SanitizeFileName(fileName As String) As String
Dim invalidChars As Variant
Dim char As Variant
Dim sanitized As String
invalidChars = Array("/", "\", ":", "*", "?", """", "<", ">", "|")
sanitized = fileName
For Each char In invalidChars
sanitized = Replace(sanitized, char, "_")
Next char
SanitizeFileName = sanitized
End Function
Now that I've been able to get to this point, I wanted to expand the pdf-file with a graph from a different sheet. So, I tried to combine text from one sheet, with a graph from a different sheet. However, I cannot seem to combine these two. The text is in a sheet called Sheet1 (range A1:A17), and the graph is in a sheet called 'Pre-NPVaR'. I created a code for it, but all i get is a pdf-file with the graph in the middle of the pdf, but the text is missing at the top. Could anyone take a look at why it doesn't work?
This is the code:
Sub SaveTextAndChartAsPDF()
Dim fileName As String
Dim filePath As String
Dim wsText As Worksheet
Dim wsChart As Worksheet
Dim tempWs As Worksheet
Dim chartObj As ChartObject
Dim dateStamp As String
' Generate a date stamp for the filename (YYYY-MM-DD)
dateStamp = Format(Now, "yyyy-mm-dd")
fileName = "MergedOutput_" & dateStamp & ".pdf"
filePath = "Private" ' Adjust the path as needed
' Set the original worksheets
Set wsText = ThisWorkbook.Sheets("Sheet1") ' Change to your actual sheet name for text
Set wsChart = ThisWorkbook.Sheets("Pre-NPVaR") ' Change to your actual sheet name for chart
' Create a temporary worksheet
Set tempWs = ThisWorkbook.Worksheets.Add
tempWs.name = "TempSheet"
' Copy the text range from the text worksheet
wsText.Range("A1:A17").Copy Destination:=tempWs.Range("A1")
tempWs.Range("A1:A17").WrapText = False
tempWs.Columns("A").AutoFit ' Adjust the column width
' Attempt to copy the chart from the chart worksheet
On Error Resume Next
Set chartObj = wsChart.ChartObjects("Chart 1") ' Adjust the chart name as needed
On Error GoTo 0
If Not chartObj Is Nothing Then
chartObj.Copy
' Paste the chart below the copied text
tempWs.Paste Destination:=tempWs.Cells(18, 1) ' Paste below the text
' Ensure the chart is positioned correctly
With tempWs.Shapes(tempWs.Shapes.Count) ' The last shape is the chart just pasted
.Top = tempWs.Cells(19, 1).Top ' Adjust position to start below the text
.Left = tempWs.Cells(1, 1).Left
End With
Else
MsgBox "Chart not found. Please check the chart name and sheet.", vbExclamation
Application.DisplayAlerts = False
tempWs.Delete
Exit Sub
End If
' Set the page layout settings for the temporary worksheet
With tempWs.PageSetup
.Orientation = xlPortrait ' or xlLandscape if content is wide
.PaperSize = xlPaperA4 ' Set paper size to A4
.FitToPagesWide = 1 ' Fit to one page wide
.FitToPagesTall = False ' Do not limit height
.Zoom = False ' Disable zoom to respect fit settings
.TopMargin = Application.InchesToPoints(0.5) ' Set top margin
.BottomMargin = Application.InchesToPoints(0.5) ' Set bottom margin
.LeftMargin = Application.InchesToPoints(0.5) ' Set left margin
.RightMargin = Application.InchesToPoints(0.5) ' Set right margin
End With
' Export the temporary worksheet to PDF
On Error GoTo ErrorHandler ' Set error handling
tempWs.ExportAsFixedFormat Type:=xlTypePDF, _
IgnorePrintAreas:=False, _
fileName:=filePath & fileName
MsgBox "PDF file saved successfully as " & fileName, vbInformation
' Clean up: Delete the temporary worksheet
Application.DisplayAlerts = False
tempWs.Delete
Application.DisplayAlerts = True
Exit Sub
ErrorHandler:
MsgBox "Error saving PDF: " & Err.Description, vbCritical
If Not tempWs Is Nothing Then
Application.DisplayAlerts = False
tempWs.Delete
Application.DisplayAlerts = True
End If
End Sub