Save in VBA and send with Outlook

[KlausW]

Hi Excel helpers
Is it possible to make this VBA code so that it only stores the tabs I have written in the code. And under a name in cell B, in PDF format.
Is it also possible to make the code so that after saving it will send, using Outlook, to an email address in cell H1.
All help will be appreciated
Klaus W

Sub Rektangelafrundedehjørner1_Klik()

 'Create and assign variables
Dim saveLocation As String
saveLocation = "C:\Users\k-wit\Documents\Rejseafregning\myPDFFile.pdf"
sheetArray = Array("Rejsebeskrivelse", "Koerselsrapport ", "Færgekort", "Billeter")
'Save active workbook as PDF
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=saveLocation

End Sub

 

[Logit]

Try this :

Option Explicit

Sub Rektangelafrundedehjørner1_Klik()



 'Create and assign variables

Dim saveLocation As String

saveLocation = "C:\Users\k-wit\Documents\Rejseafregning\" & Sheet1.Range("B1").Value & ".pdf"

sheetArray = Array("Rejsebeskrivelse", "Koerselsrapport ", "Færgekort", "Billeter")

'Save active workbook as PDF

ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _

    Filename:=saveLocation



End Sub
Public Sub SaveSheetsAsPDF()

    Dim wksAllSheets As Variant
    Dim wksSheet1 As Worksheet
    Dim strFilename As String, strFilepath As String
   
    'Set references up-front
    Set wksSheet1 = ThisWorkbook.Sheets("Sheet1")
    wksAllSheets = Array("Rejsebeskrivelse", "Koerselsrapport ", "Færgekort", "Billeter")
    strFilepath = "C:\Users\k-wit\Documents\Rejseafregning\" & Sheet1.Range("B1").Value & ".pdf"
   
    'Create the full Filename using cells D6, E6 and F6
    With wksSheet1
   
        'Assemble the string cell-by-cell, "D6 E6-F6"
            strFilepath = "C:\Users\k-wit\Documents\Rejseafregning\" & Sheet1.Range("B1").Value & ".pdf"
                   
    End With
   
    'Save the Array of worksheets (which will be selected) as a PDF
    ThisWorkbook.Sheets(wksAllSheets).Select
    wksSheet1.ExportAsFixedFormat _
              Type:=xlTypePDF, _
              Filename:=strFilepath, _
              Quality:=xlQualityStandard, _
              IncludeDocProperties:=True, _
              IgnorePrintAreas:=False, _
              OpenAfterPublish:=True
             
    'Make sure all the worksheets are NOT left selected
    wksSheet1.Select
    Mail_workbook_Outlook
End Sub


Sub Mail_workbook_Outlook()


    Dim OutApp As Object
    Dim OutMail As Object
    Dim sndEmail As String
    Dim toEmail As String
    Dim ccEmail As String
    Dim bccEmail As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
 

    On Error Resume Next
    With OutMail
        .To = Sheet1.Range("H1").Value
        .CC = ""
        .BCC = ""
        .Subject = "Daily Report"
        .Body = "Daily Report Attached"
        .Attachments.Add ("C:\Users\k-wit\Documents\Rejseafregning\" & Sheet1.Range("B1").Value & ".pdf") 'attaches pdf file
        .Display                           '<-- .Display will show the email first for review
        '.Send                               '<-- .Send will auto send email without review
                                 
    End With
    On Error GoTo 0


    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

 

[KlausW]

Try this :

Option Explicit

Sub Rektangelafrundedehjørner1_Klik()



 'Create and assign variables

Dim saveLocation As String

saveLocation = "C:\Users\k-wit\Documents\Rejseafregning\" & Sheet1.Range("B1").Value & ".pdf"

sheetArray = Array("Rejsebeskrivelse", "Koerselsrapport ", "Færgekort", "Billeter")

'Save active workbook as PDF

ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _

    Filename:=saveLocation



End Sub
Public Sub SaveSheetsAsPDF()

    Dim wksAllSheets As Variant
    Dim wksSheet1 As Worksheet
    Dim strFilename As String, strFilepath As String
  
    'Set references up-front
    Set wksSheet1 = ThisWorkbook.Sheets("Sheet1")
    wksAllSheets = Array("Rejsebeskrivelse", "Koerselsrapport ", "Færgekort", "Billeter")
    strFilepath = "C:\Users\k-wit\Documents\Rejseafregning\" & Sheet1.Range("B1").Value & ".pdf"
  
    'Create the full Filename using cells D6, E6 and F6
    With wksSheet1
  
        'Assemble the string cell-by-cell, "D6 E6-F6"
            strFilepath = "C:\Users\k-wit\Documents\Rejseafregning\" & Sheet1.Range("B1").Value & ".pdf"
                  
    End With
  
    'Save the Array of worksheets (which will be selected) as a PDF
    ThisWorkbook.Sheets(wksAllSheets).Select
    wksSheet1.ExportAsFixedFormat _
              Type:=xlTypePDF, _
              Filename:=strFilepath, _
              Quality:=xlQualityStandard, _
              IncludeDocProperties:=True, _
              IgnorePrintAreas:=False, _
              OpenAfterPublish:=True
            
    'Make sure all the worksheets are NOT left selected
    wksSheet1.Select
    Mail_workbook_Outlook
End Sub


Sub Mail_workbook_Outlook()


    Dim OutApp As Object
    Dim OutMail As Object
    Dim sndEmail As String
    Dim toEmail As String
    Dim ccEmail As String
    Dim bccEmail As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
 

    On Error Resume Next
    With OutMail
        .To = Sheet1.Range("H1").Value
        .CC = ""
        .BCC = ""
        .Subject = "Daily Report"
        .Body = "Daily Report Attached"
        .Attachments.Add ("C:\Users\k-wit\Documents\Rejseafregning\" & Sheet1.Range("B1").Value & ".pdf") 'attaches pdf file
        .Display                           '<-- .Display will show the email first for review
        '.Send                               '<-- .Send will auto send email without review
                                
    End With
    On Error GoTo 0


    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

I got error in
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _

Filename:=saveLocation

Can I put the hole VBA code in a modul?

 

[KlausW]

I got error in
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _

Filename:=saveLocation

Can I put the hole VBA code in a modul?

And under a name in cell B1, in PDF format

saveLocation = "C:\Users\k-wit\Documents\Rejseafregning\" & Sheet1.Range("B1").Value & ".pdf" In this line I got error in &Sheet1.

 

[Logit]

Re: Filename:=saveLocation ... is this the correct location where you are saving the PDF file ?

"C:\Users\k-wit\Documents\Rejseafregning\"

Re: name in cell B1 ... is the cell B1 located in : Sheet1 ?

If the answer to either of the above is "NO" ... change the location to suit your computer.

 

[KlausW]

Re: Filename:=saveLocation ... is this the correct location where you are saving the PDF file ?

"C:\Users\k-wit\Documents\Rejseafregning\"

Re: name in cell B1 ... is the cell B1 located in : Sheet1 ?

If the answer to either of the above is "NO" ... change the location to suit your computer.

This is where I are saving the PDF fileC:\Users\k-wit\Documents\Rejseafregning\

Cell B1 is the name of the fil, an cell B1 is in sheet1. Sheet1's name is Stamdata

 

[Logit]

Try this :

"C:\Users\k-wit\Documents\Rejseafregning\" & Sheets("Stamdata").Range("B1").Value & ".pdf"

 

[Logit]

Did it work ???

 

[KlausW]

Did it work ???

I am sorry to say, I got this error variable not defined in sheetArray

 

[Logit]

Did you delete this portion of the posted macro ? If not ... please delete it:

Sub Rektangelafrundedehjørner1_Klik()



 'Create and assign variables

Dim saveLocation As String

saveLocation = "C:\Users\k-wit\Documents\Rejseafregning\" & Sheet1.Range("B1").Value & ".pdf"

sheetArray = Array("Rejsebeskrivelse", "Koerselsrapport ", "Færgekort", "Billeter")

'Save active workbook as PDF

ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _

    Filename:=saveLocation



End Sub

That was my mistake in posting it. It is no longer required. The only two parts of the macro that you should be utilizing is :

Public Sub SaveSheetsAsPDF()

    Dim wksAllSheets As Variant
    Dim wksSheet1 As Worksheet
    Dim strFilename As String, strFilepath As String
  
    'Set references up-front
    Set wksSheet1 = ThisWorkbook.Sheets("Sheet1")
    wksAllSheets = Array("Rejsebeskrivelse", "Koerselsrapport ", "Færgekort", "Billeter")
    strFilepath = "C:\Users\k-wit\Documents\Rejseafregning\" & Sheet1.Range("B1").Value & ".pdf"
  
    'Create the full Filename using cells D6, E6 and F6
    With wksSheet1
  
        'Assemble the string cell-by-cell, "D6 E6-F6"
            strFilepath = "C:\Users\k-wit\Documents\Rejseafregning\" & Sheet1.Range("B1").Value & ".pdf"
                  
    End With
  
    'Save the Array of worksheets (which will be selected) as a PDF
    ThisWorkbook.Sheets(wksAllSheets).Select
    wksSheet1.ExportAsFixedFormat _
              Type:=xlTypePDF, _
              Filename:=strFilepath, _
              Quality:=xlQualityStandard, _
              IncludeDocProperties:=True, _
              IgnorePrintAreas:=False, _
              OpenAfterPublish:=True
            
    'Make sure all the worksheets are NOT left selected
    wksSheet1.Select
    Mail_workbook_Outlook
End Sub


Sub Mail_workbook_Outlook()


    Dim OutApp As Object
    Dim OutMail As Object
    Dim sndEmail As String
    Dim toEmail As String
    Dim ccEmail As String
    Dim bccEmail As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
 

    On Error Resume Next
    With OutMail
        .To = Sheet1.Range("H1").Value
        .CC = ""
        .BCC = ""
        .Subject = "Daily Report"
        .Body = "Daily Report Attached"
        .Attachments.Add ("C:\Users\k-wit\Documents\Rejseafregning\" & Sheet1.Range("B1").Value & ".pdf") 'attaches pdf file
        .Display                           '<-- .Display will show the email first for review
        '.Send                               '<-- .Send will auto send email without review
                                
    End With
    On Error GoTo 0


    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Be certain to make the change shown in my Post #7 :

"C:\Users\k-wit\Documents\Rejseafregning\" & Sheets("Stamdata").Range("B1").Value & ".pdf"

Your command button that runs the macros should be linked to this macro : Public Sub SaveSheetsAsPDF