+- Office-Fragen.de (https://office-fragen.de)
+-- Forum: Microsoft Office (https://office-fragen.de/forum-1.html)
+--- Forum: Excel (https://office-fragen.de/forum-2.html)
+--- Thema: Vordefinierter Dateiname 64bit Problem (/thread-4315.html)
Vordefinierter Dateiname 64bit Problem - AarZeon - 13.11.2019
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
RE: Vordefinierter Dateiname 64bit Problem - EbyAS - 13.11.2019
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.