I am new to VBA and managed to cobble together code from tutorials to convert active sheet to PDF and place whole workbook into new folder but I am struggling writing code to convert multiple sheets from workbook into one pdf and place whole workbook into new folder. Below is the coding but it either tells me i am missing an Else If or jumps to "The active worksheet cannot be blank" which it isn't. I would appreciate some guidance where I am going wrong, think it is in relation to the Array section and me not writing it correctly.
Here Goes
Code: Select all
Private Sub CommandButton1_Click()
Dim xWbk As Workbook
Dim xSht As Worksheet
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xYesorNo As Integer
Dim xOutlookObj As Object
Dim xEmailObj As Object
Dim xUsedRng As Range
Set xSht = ActiveSheet
Set xWbk = ActiveWorkbook
xFolder = "F:\M Hub\M Workbook\Im Import PDFs" + "\" + xSht.Name + "-" + Worksheets("Packaging").Range("Packaging!F2") + "-" + Worksheets("Packaging").Range("Packaging!C3").Text + ".pdf"
'Check if file already exist
If Len(Dir(xFolder)) > 0 Then
xYesorNo = MsgBox(xFolder & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", _
vbYesNo + vbQuestion, "File Exists")
On Error Resume Next
If xYesorNo = vbYes Then
Kill xFolder
Else
MsgBox "if you don't overwrite the existing PDF, I can't continue." _
& vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
Exit Sub
End If
If Err.Number <> 0 Then
MsgBox "Unable to delete existing file. Please make sure the file is not open or write protected." _
& vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
Exit Sub
End If
End If
Set xSht = ActiveSheet
Set xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
'Save as PDF file
Sheets(Array(“2”’,”3”,”5”)).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder & “\Sales”’ _
Quality:=xlQualityStandard
Else
MsgBox "The active worksheet cannot be blank"
Exit Sub
End If
MsgBox "PDF’s have been successfully exported."
xFolder = "F:\ Hub\M Workbook\Completions To Diary" + "\" + Worksheets("Packaging").Range("Packaging!F2") + "-" + Worksheets("Packaging").Range("Packaging!C3").Text + ".xlsm"
'Check if file already exist
If Len(Dir(xFolder)) > 0 Then
xYesorNo = MsgBox(xFolder & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", _
vbYesNo + vbQuestion, "File Exists")
On Error Resume Next
If xYesorNo = vbYes Then
Kill xFolder
Else
MsgBox "if you don't overwrite the existing file, I can't continue." _
& vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
Exit Sub
End If
If Err.Number <> 0 Then
MsgBox "Unable to delete existing file. Please make sure the file is not open or write protected." _
& vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
Exit Sub
End If
End If
Dim sExcelFile As String
xFolder = "F:\M Hub\M Workbook\Completions To Diary" + "\" + Worksheets("Packaging").Range("Packaging!F2") + "-" + Worksheets("Packaging").Range("Packaging!C3").Text + ".xlsm"
sExcelFile = Application.GetSaveAsFilename(xFolder, "Excel Macro-Enabled workbook(*.xlsm), *.xlsm")
If xFolder = "False" Then
Exit Sub
End If
ActiveWorkbook.SaveAs sExcelFile
End Sub
Donna
