简体   繁体   中英

Excel VBA macro to save excel workbook to pdf will not save

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.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM