Макрос Excel VBA для сохранения книги Excel в PDF не сохранит

Question

У меня есть книга Excel с несколькими вкладками, и я создал запланированную задачу Windows, чтобы открыть книгу и сохранить книгу в pdf, однако при отладке этой части кода возникла ошибка. Я думаю, что это может быть предыдущий экземпляр, который обработал и оставил тот же PDF-файл в той же папке. Возможно, он не перезаписывает старый PDF-файл.

ERROR Run Time Error '-214701887 (80071779)'; Документ не сохранен.

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

Answer 1

Попробуйте это.

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