I have an excel workbook with multiple tabs and I created a Windows scheduled task to open the workbook and save the workbook to pdf however there is a error with this portion of the code when i debugged it. I think it may be the previous instance that had processed and left the same pdf in the same folder. It may not be overwritting the old pdf.
ERROR Run Time Error '-214701887 (80071779)'; Document not saved.
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=saveLocation
FULL VBA
Sub Auto_Open()
Dim sht As Worksheet
'AutoFit Every Worksheet Column in a Workbook
For Each sht In ThisWorkbook.Worksheets
sht.Cells.EntireColumn.AutoFit
Next sht
Application.DisplayAlerts = False
'Create and assign variables
Dim saveLocation As String
saveLocation = "C:\Users\manuel\Documents\SQL Server Management Studio\alert-email\LOG.PDF"
Application.DisplayAlerts = True
'Save active workbook as PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=saveLocation
Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim myAtttachments As Object
Set OutLookApp = CreateObject("Outlook.Application")
Set OutLookMailItem = OutLookApp.CreateItem(0)
Set myAttachments = OutLookMailItem.Attachments
With OutLookMailItem
.To = "manuel@gmail.com"
.Subject = "Test Summary"
.Body = "This e-email is automatically generated and will be sent every weekday at 6AM. We can customerize and add more reports later."
myAttachments.Add "C:\Users\manuel\Documents\SQL Server Management Studio\alert-email\LOG.PDF"
.send
'.Display
End With
Set OutLookMailItem = Nothing
Set OutLookApp = Nothing
ThisWorkbook.Save
ThisWorkbook.Saved = True
Application.Quit
End Sub
Try this.
Option Explicit
Sub ExportXLToPDF()
'Comments:
'Assume list of worksheets to be included in output are listed in Column 1 on "List"
Dim wb As Workbook
Dim ws As Worksheet
Dim Arr() As String
Dim MaxRows As Long
Dim i As Long
Dim strPath As String
Dim strFileName As String
Const strEXTENSION As String = ".pdf"
Set wb = ThisWorkbook
Set ws = wb.Worksheets("List")
'User - where to save the output file
strPath = GetFolder & "\"
'User - what to name the output file
strFileName = GetUserInput(strPrompt:="Please enter a name for the output file", _
strTitle:="File Name")
'Assume list to be included in sheets array in on worksheet named list in Column 1 beginning in Row 1
'Total number of rows is dynamic
MaxRows = GetRows(ws:=ws)
'Redim the array to hold the name of the worksheets
ReDim Preserve Arr(1 To MaxRows)
'Load the list of sheets to be included into the array
For i = 1 To MaxRows
Arr(i) = ws.Cells(i, 1).Value
Next i
'Select the sheets array
Sheets(Arr).Select
'Export to the sheets array to pdf
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=strPath & strFileName & strEXTENSION, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'Tidy up
'Erase arrays
Erase Arr
'Destroy objects
Set ws = Nothing
Set wb = Nothing
End Sub
Public Function GetRows(ws As Worksheet) As Long
Dim r As Long
With ws
r = .Cells(Rows.Count, 1).End(xlUp).Row
GetRows = r
End With
End Function
Public Function GetUserInput(strPrompt As String, _
strTitle As String) As String
Dim strUserInput As String
strUserInput = InputBox(Prompt:=strPrompt, _
Title:=strTitle)
GetUserInput = strUserInput
End Function
Public Function GetFolder() As String
Dim fd As FileDialog
Dim strFolderName As String
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
.Title = "Please select a folder"
.AllowMultiSelect = False
.Show
strFolderName = .SelectedItems(1)
End With
GetFolder = strFolderName
Set fd = Nothing
End Function
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.