Макрос Excel припинив роботу після оновлення Windows kb4103729

З моменту оновлення Windows версії 1803 kb4103729 мій Макрос для створення PDF-файлу та надсилання рахунку-фактури перестав працювати. Це макрос з декількома командами в ньому та посиланнями на робочий аркуш і на папку призначення (див. Нижче).

Я перевірив усі посилання та застосував усі рішення, які я міг знайти тут: видалення всіх .exd-файлів та зміна мовних налаштувань для запуску коду VBA (оновлення впливає на мовні пакети, і я запускаю голландську версію excel). Сподіваюся, хтось може мені допомогти на цьому.

Проблема, схоже, є специфічною для цього макросу (всі версії, які я маю, одна для кредитних купюр і дві для рахунків-фактур іншими мовами, це стосується, але не інші Макроси). Він надає мені друге поле помилок ("Неможливо створити PDF, можливі причини: ...").

Ось макрос:

Sub Create_PDFmail () Dim FileName As String

If ActiveWindow.SelectedSheets.Count > 1 Then
    MsgBox "There is more then one sheet selected," & vbNewLine & _
           "ungroup the sheets and try the macro again"
Else

    FileName = RDB_Create_PDF(Source:=Range("A1:F39"), _
                              FixedFilePathName:="C:\Users\woute\SharePoint\CareerCoach - Admin\Boekhouding\Verkoopfacturen\CC Factuur " & ThisWorkbook.Sheets("Template").Range("Template!E11").Value & ".pdf", _
                              OverwriteIfFileExist:=True, _
                              OpenPDFAfterPublish:=False)

    'For the selection use Selection in the Source argument
    'FileName = RDB_Create_PDF(Source:=Selection)

    'For a fixed file name use this in the FixedFilePathName argument
    'FixedFilePathName:="C:\Users\Ron\Test\YourPdfFile.pdf"

    If FileName <> "" Then
        RDB_Mail_PDF_Outlook FileNamePDF:=FileName, _
                             StrTo:=ThisWorkbook.Sheets("Template").Range("Template!H2").Value, _
                             StrCC:="", _
                             StrBCC:="", _
                             StrSubject:="factuur " & ThisWorkbook.Sheets("Template").Range("Template!E11").Value, _
                             Signature:=True, _
                             Send:=False, _
                             StrBody:="<body>Beste " & Range("Template!H3").Value & ",<br><br>" & _
                                        "In bijlage vindt u de meest recente factuur voor de dienstverlening <b><i>" & Range("Template!B12").Value & ".</i></b>" & _
                                        "<br>" & "...Bunch of body text" & _
                                       </body>"

    Else
        MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
               "Microsoft Add-in is not installed" & vbNewLine & _
               "You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
               "The path to Save the file in arg 2 is not correct" & vbNewLine & _
               "You didn't want to overwrite the existing PDF if it exist"
    End If
End If

Кінець Під

У мене була та сама проблема, і я її вирішив, зробивши наступне:

Windows + R та виконати% COMMONPROGRAMFILES%

Потім перейдіть до "Microsoft Shared", тепер знайдіть EXP_PDF.DLL у будь-якій папці OFFICEXX і скопіюйте її в папку OFFICE16.

Спробуйте ваш макрос.

Якщо він не працює, ви все ще можете прокоментувати рядки, що перевіряють установку надбудови (Перший блок блоку та останній блок EndIf) у функції RDB_create_PDF:

    Function RDB_Create_PDF(Myvar As Object, FixedFilePathName As String, _
             OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
Dim FileFormatstr As String
Dim Fname As Variant

'Test to see if the Microsoft Create/Send add-in is installed.
If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _
     & Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then

    If FixedFilePathName = "" Then
        'Open the GetSaveAsFilename dialog to enter a file name for the PDF file.
        FileFormatstr = "PDF Files (*.pdf), *.pdf"
        Fname = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, _
              Title:="Create PDF")

        'If you cancel this dialog, exit the function.
        If Fname = False Then Exit Function
    Else
        Fname = FixedFilePathName
    End If

    'If OverwriteIfFileExist = False then test to see if the PDF
    'already exists in the folder and exit the function if it does.
    If OverwriteIfFileExist = False Then
        If Dir(Fname) <> "" Then Exit Function
    End If

    'Now export the PDF file.
    On Error Resume Next
    Myvar.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=Fname, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=OpenPDFAfterPublish
    On Error GoTo 0

    'If the export is successful, return the file name.
    If Dir(Fname) <> "" Then RDB_Create_PDF = Fname
End If
End Function

Сподіваюся, це допоможе, якщо все-таки потрібно.