VBA to save some sheets as xlxs and some as PDF

[Padthelad]

Hi,

I am hoping for some help to for VBA code to save some sheets as xlxs and some as pdf.

I am using the below code to save all sheets as xlxs with a filename as the name of the sheet within the workbook.

Sub SaveShtsAsBook()
    Dim Sheet As Worksheet, SheetName$, MyFilePath$, N&
    MyFilePath$ = ActiveWorkbook.Path & "\" & _
    Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
         '      End With
        On Error Resume Next '<< a folder exists
        MkDir MyFilePath '<< create a folder
        For N = 1 To Sheets.Count
            Sheets(N).Activate
            SheetName = ActiveSheet.Name
            Cells.Copy
            Workbooks.Add (xlWBATWorksheet)
            With ActiveWorkbook
                With .ActiveSheet
                    .Paste
                    .Name = SheetName
                    [A1].Select
                End With
                 'save book in this folder
                .SaveAs Filename:=MyFilePath _
                & "\" & SheetName & ".xls"
                .Close SaveChanges:=True
            End With
            .CutCopyMode = False
        Next
    End With
    Sheet1.Activate
End Sub

I would like to adapt this code so that in the tab name has INV in it, then save as pdf if not, save as xlxs.

As a second issue, but not as vital I would ultimately to combine it with this code to send the saved copies as attachments to emails.

Sub AttachActiveSheetPDF()
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("B10")

' 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

' 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)
 

    .Subject = CStr(Range("A8").Value)
Dim Mailadress As String
Mailadress = CStr(Range("B40").Value)
.to = Mailadress
.CC = ""
.Body = "Dear " & ActiveSheet.Range("B34 ").Value & " " & ActiveSheet.Range(" C34").Value & "," & vbLf & vbLf _
& "Please find attached document from ************ ." & vbLf & vbLf _
& "Should you have any questions or queries, do not hesitate to contact *******************." & vbLf & vbLf _
& "Kind regards," & vbLf & vbLf _
& Application.UserName & vbLf & vbLf
.Attachments.Add PdfFile
.Attachments.Add "******************.pdf"
   


On Error Resume Next
.Display
Application.Visible = True
If Err Then
MsgBox "E-mail was not sent", vbExclamation
Else
MsgBox "E-mail successfully Exported to Outlook. Remeber to press send!", vbInformation
End If
On Error GoTo 0

End With

Kill PdfFile

If IsCreated Then OutlApp.Quit

Set OutlApp = Nothing

End Sub

Any help is gratefully received.

Many thanks,

Pad

 

[Snakehips]

@Padthelad
Does this help...

Sub SaveShtsAsBookOrPdf()
    Dim Sheet As Worksheet, SheetName$, MyFilePath$, N&
    MyFilePath$ = ActiveWorkbook.Path & "\" & _
    Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
         '      End With
        On Error Resume Next '<< a folder exists
        MkDir MyFilePath '<< create a folder
        For N = 1 To Sheets.Count
            Sheets(N).Activate
            SheetName = ActiveSheet.Name
            'Check if contains "INV"
            If Not InStr(1, SheetName, "INV") Is Nothing Then
            'Save as pdf
                Sheets(N).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                 MyFilePath & "\" & SheetName & ".pdf", Quality:=xlQualityStandard, _
                 IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
                    False
            

           Else
           
           
            Cells.Copy
            Workbooks.Add (xlWBATWorksheet)
            With ActiveWorkbook
                With .ActiveSheet
                    .Paste
                    .Name = SheetName
                    [A1].Select
                End With
                 'save book in this folder
                .SaveAs Filename:=MyFilePath _
                & "\" & SheetName & ".xls"
                .Close SaveChanges:=True
            End With
            .CutCopyMode = False
            End If
        Next
    End With
    Sheet1.Activate
End Sub

 

[Padthelad]

Hi Snakehips,

Thank you for coming back to me on this.

The code hits an error as per the attached image. I am at a loss as to why, any ideas?

Many thanks,

Pad

 

[Snakehips]

Hi Pad,
I'm unsure how it ran for me with that line as is?
However, alter it to

If Not InStr(1, SheetName, "INV", 1) > 0 Then

and see how it goes.

 

[Padthelad]

Works a treat! Thanks Snakehips!