Office-Fragen.de

Guten Tag Zusammen,

Ich habe einen VBA Code der, den Namen eines Files durch eine Zelle vordefiniert. Jedoch funktioniert dieser nur bei einem 32bit System und bei 64bit Systeme mit der Datei Kernel32.dll. Der Error ist im Anhang als Bild zufinden.

Könnte mir jemand helfen diesen Code umzuschreiben. Es Fehler liegt nur an der 3 Zeile.

Option Explicit

Private Declare Function SetCurrentDirectory Lib "kernel32.dll" Alias "SetCurrentDirectoryA" ( _
    ByVal lpPathName As String) As Long

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    Dim strInitialFileName As String
    Dim vntFileName As Variant
    Dim blnSave As Boolean

    If SaveAsUI Then

        strInitialFileName = Range("K51").Value & "_" & Worksheets("Sprachen").Range("D34").Value & ".xlsx"

        If Path <> vbNullString Then Call SetCurrentDirectory(Path)

        Do

            vntFileName = Application.GetSaveAsFilename( _
                InitialFileName:=strInitialFileName, _
                FileFilter:="Excelmappe (*.xlsx), *.xlsx")

            If VarType(vntFileName) = vbString Then

                If Dir$(vntFileName) <> vbNullString Then

                    Select Case MsgBox("Die Datei " & Name & " besteht bereits. " & _
                        "Möchten Sie die bestehende Datei ersetzen?", _
                        vbExclamation Or vbYesNo)
                        Case vbYes
                            blnSave = True
                        Case vbNo
                            blnSave = False
                    End Select

                Else
                    blnSave = True
                End If

                If blnSave Then

                    With Application
                        .EnableEvents = False
                        .DisplayAlerts = False

                        SaveAs Filename:=vntFileName

                        .EnableEvents = True
                        .DisplayAlerts = True
                    End With

                    Exit Do

                End If
            Else

                Exit Do

            End If
        Loop

        Cancel = True

    End If
End Sub

Vielen Dank für die Hilfe!

Gruss AarZeon

Hallo,
versuche einmal die Definition zu ändern:

Private Declare PtrSafe Function SetCurrentDirectory Lib "kernel32.dll" Alias "SetCurrentDirectoryA" ( _
ByVal lpPathName As String) As Long

Ist erst ab WIN 10 1903 und Office 2019 nach meinem Kenntnistand nicht mehr erforderlich.