Speichername und Verzeichnis

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _ ByVal lpPath As String) As Long Sub Datei_zwischenspeichern() Dim sPfad As String Dim sName As String sPfad = "F:\testx\2022\2022_11\" sName = "XXX_" & Range("A1").Text If Dir(sPfad & sName & ".xlsm") "" Then MsgBox "Schon vorhanden" Exit Sub Else If MakeSureDirectoryPathExists(sPfad) = 0 Then MsgBox "Der Ordner " & sPfad & " konnte nicht angelegt werden!", vbCritical, "Ordner anlegen" End If ActiveWorkbook.SaveCopyAs sPfad & sName & ".xlsm" MsgBox ("Datei wurde erfolgreich zwischengespeichert.") End If End Sub

Option Explicit Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long Sub Datei_zwischenspeichern() Dim sPfad As String Dim sName As String sPfad = "F:\testx\" & Year(Range("B4")) & "\" & Year(Range("B4")) & "_" & Month(Range("B4")) & "\" If Range("D4") = vbNullString Then MsgBox "Nummer fehlt", vbCritical, "Abbruch": Exit Sub sName = "XXX_" & Range("D4").Text If Dir(sPfad & sName & ".xlsm") "" Then MsgBox "Schon vorhanden" Exit Sub Else If MakeSureDirectoryPathExists(sPfad) = 0 Then MsgBox "Der Ordner " & sPfad & " konnte nicht angelegt werden!", vbCritical, "Ordner anlegen" End If ActiveWorkbook.SaveCopyAs sPfad & sName & ".xlsm" MsgBox ("Datei wurde erfolgreich zwischengespeichert.") End If End Sub

Hey,
ich dachte damit ist es erledigt, aber wie immer kommt doch dann noch ein Problem auf. Ich habe nun folgendes Makro für Speichern+Schließen.
Option Explicit
Private Declare PtrSafe


Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long

Sub Datei_zwischenspeichern()
Dim sPfad As String
Dim sName As String
sPfad = "F:\testx\" & Format(Date, "yyyy") & "\" & Format(Date, "yyyy_mm") & "\"
If Range("D4") = vbNullString Then MsgBox "Nummer fehlt", vbCritical, "Abbruch": Exit Sub
sName = "XXX_" & Range("D4").Text
If Dir(sPfad & sName & ".xlsm")  "" Then
MsgBox "Schon vorhanden"
Exit Sub
Else
If MakeSureDirectoryPathExists(sPfad) = 0 Then
MsgBox "Der Ordner " & sPfad & " konnte nicht angelegt werden!", vbCritical, "Ordner anlegen"
End If
ActiveWorkbook.SaveCopyAs sPfad & sName & ".xlsm"
MsgBox ("Datei wurde erfolgreich zwischengespeichert.")
End If
ActiveWorkbook.Close savechanges:=False
End Sub

Folgender Hintergrund: Die Vorlage-Datei wird schreibgeschützt geöffnet, einige Werte eingetragen und über das obige Makro (danke nochmal) perfekt benannt und abgelegt. Die Vorlage bleibt damit geschützt und unverändert. Die erstellte Kopie wird später nochmal geöffnet, um weiteren Inhalt einzutragen. An der Stelle versagt dann natürlich das Makro, da die Datei bereits vorhanden ist. Ich würde hier gerne zulassen dass die Datei überschrieben wird. Aber nur diese Datei mit diesem Namen damit nicht fälschlicherweise eine Datei zuvor (Unterschied nur in der laufenden Nr.) überschrieben wird. Hast du/ihr eine Idee, wie ich das realisieren könnte?

Hey Onur,
danke für die Antwort. Jetzt ist noch nicht gesichert dass versehentlich (bei Eintrag der falschen laufenden Nr.) eine falsche Datei überschrieben wird. Das regel ich aber einfach mit Zellschutz der Zelle beim ersten Speichern .
Ein Gedankenfehler/Problem beseitigt und schon kommt das nächste auf. Habe ja beschrieben, dass die Hauptdatei eine Vorlage ist mit Schreibschutz. Die mit dem Speichern-Makro abgelegte Kopie soll jedoch keinen Schreibschutz enthalten, da die ja wieder geändert wird.
Schreibschutz habe ich im Workbook.Open Event realisiert:
Private Sub Workbook_Open()
ThisWorkbook.ChangeFileAccess Mode:=xlReadOnly
Wie könnte ich dies für die Kopie entfernen? Gibt es sowas wie SafeCopyAs "without protection" :D?

Beliebteste Forumthreads (12 Monate)

16 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread