Save as verhindern bei Datumskonflikt
Dietmar
habe eine knifflige und wie ich meine interessate Sache:
Ich habe ein kleines Programm geschrieben, das ich einigen Leutchen zur Verfügung stelle. Dieses erhält auch Updates, um inhaltliche Änderungen zu übertragen. Updates suchen die Datei (hier: test123.xls) immer an der gleichen Stelle, nämlich in C:\OrdnerXY.
Dorthin erfolgt daher bei jedem Öffnen der Datei eine sofortige Speicherung. Dafür habe ich ein "Application.Run Speichern" erstellt, das auch ohne Nachfrage ausgeführt wird.
Meine Frage:
Wie könnte ich den Code verfeinern, so dass die aktuell zu öffnende test123-Datei nur dann in die Speicherroutine kommt, wenn diese ein älteres Änderungsdatum aufweist als die Datei, die zu diesem Zeitpunkt an dem vorgegebenen Ort gespeichert ist?
Grund: Die Datei wird von dem einen oder anderen per Explorer auf einen Stick gezogen und abgelegt. Dann wird aber mit der Originaldatei (C:\OrdnerXY\test123.xls) weitergearbeitet, so dass die "Stickdatei" sofort veraltet ist. Es soll nicht möglich sein, eine die Stick-Dateiversion zu öffnen, die ein jüngeres Änderungsdatum aufweist, weil die an dem vorgesehenen Speicherort befindliche Datei, diese dann überschreiben würde. Dann soll eine msgbox mit YesNo erscheinen, die auf den Konflikt hinweist.
Ich bin gespannt. Vorab vielen Dank!
Dietmar aus Aachen
Hier mein Code:
Option Explicit
Private Sub Workbook_Open()
Application.ScreenUpdating = False
If Dir("C:\OrdnerXY", vbDirectory) = "" Then
MkDir ("C:\ OrdnerXY ")
MsgBox "Der OrdnerXY e wurde angelegt", vbInformation, "Hinweis"
Else
'MsgBox "Hinweis:" & vbCrLf & "" & vbCrLf & "Der Ordner C:\OrdnerXY für die Speicherung der _
Datei ist vorhanden." & vbCrLf & "" & vbCrLf & "Bitte verändern Sie den genannten Pfad nicht(!), da Updates sonst nicht funktionieren.", vbExclamation, "Hinweis"
Dim inttab As Integer 'Passwort auf allen Seiten aktivieren
For inttab = 1 To Worksheets.Count
Sheets(inttab).Protect ("12345678")
Next inttab
Worksheets("Eingangsseite").Activate 'Die Eingangsseite aufrufen
'Das Programm in den vorgesehenen Pfad speichern
Application.Run "Speichern"
Application.Run "SpeichernUnterNein" 'Zugriff auf Speichern unter verhindern
Application.ScreenUpdating = True
End Sub
Option Explicit
Sub Speichern()
If Dir("C:\OrdnerXY\test123.xls", vbDirectory) = "" Then
MsgBox "Die Datei wurde wie folgt gespeichert: C:\OrdnerXY\test123" & vbCrLf & "viel Spass", _
vbInformation, "Hinweis"
Else
End If
Application.DisplayAlerts = False 'Nachfrage ausschalten, damit Zwangsspeicherung erfolgen _
kann
ActiveWorkbook.SaveAs Filename:="C:\OrdnerXY\test123.xls"
Application.DisplayAlerts = True 'Nachfrage einschalten
End Sub