Liebe VBA-Profis,

ich habe ein Problem mit einem Makro, nur leider bin ich alles andere als ein Infromatik-Pro! Daher wollte ich euch um Hilfe bitten.

Es funktioniert bei allen Kollegen, bis auf eine Kollegin - sie hat seit kurzem Probleme.

Sie bekommt diese Fehlermeldung: run time error 1004 document not saved the document may be open or an error may have been enconterd when saving.

Wenn andere das Makro nutzen funktioert es tadellos.

Funktion:

Das Makro erstell eine pdf Datei, öffnet Outlook Email mit der pdf im Anhang und wird auch als pdf gleichzeig in einem Ordner abgelegt.

Info:

* wir sind momentan noch im Home-Office und greifen über VPN auf unseren Server zu

* in einer ähnlichen Datei mit exakt selbem Makro Code kann sie die pdf erstellen und auch Outlook öffnet sich

* Neustart wurde mehrmals gemacht

An was könnte es liegen?

Das ist der Code:

Option Explicit

Sub aktivesBlattToPdf()

Dim PDFFileName As String
Dim LastRow As Integer
Dim PDFPath As String
Dim OrderStatus As String
Dim OrderType As String
Dim SupplierName As String
Dim CRDConfirmed As String
Dim xOutlookObj As Object
Dim xEmailObj As Object

PDFPath = ThisWorkbook.Path & "\Style Sheet"

With Worksheets("Supplier_Sheet").AutoFilter.Range
       OrderStatus = Range("A" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row).Value2
       SupplierName = Range("C" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row).Value2
       OrderType = Range("B" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row).Value2
       CRDConfirmed = Range("AG" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row).Value
End With


PDFFileName = Range("D3") & "_" & OrderType & "_" & Range("F3") & "_" & SupplierName & "_" & CRDConfirmed & ".pdf"
LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "B").End(xlUp).Row

If Dir(PDFPath, vbDirectory) = "" Then
    
    MsgBox "Please create a folder name: Invoice Sheet"

Else
    
    Sheets("Supplier_Sheet").Range("D2:AN" & LastRow).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    PDFPath & "\" & PDFFileName, Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True


    'Create Outlook email
    Set xOutlookObj = CreateObject("Outlook.Application")
    Set xEmailObj = xOutlookObj.CreateItem(0)
    With xEmailObj
        .Display
        .To = ""
        .CC = ""
        .Subject = PDFFileName
        .Attachments.Add PDFPath & "\" & PDFFileName
    End With
End If

End Sub

Vielen lieben Dank!!! Nora