Beim "Speichern unter" Prüfung welche Datei älter

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Dietmar,
dann probier es mal so.

' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Const cstrSaveAsName As String = "E:\Temp\dietmar.xls"

Private Sub Workbook_Open()
  Dim bSave As Boolean
  bSave = True
  If Dir(cstrSaveAsName) <> "" Then
    If checkFileTime(cstrSaveAsName, Me.FullName) Then
      bSave = MsgBox("Die Datei die Sie speichern wollen, ist älter" & vbLf & _
        "als die bereits vorhandene Datei!" & vbLf & vbLf & "Wollen Sie" & _
        " trotzdem fortsetzen?", vbInformation + vbYesNo + vbDefaultButton2, _
        "Hinweis") = vbYes
    End If
  End If
  If bSave Then
    Application.DisplayAlerts = False
    Me.SaveAs cstrSaveAsName
    Application.DisplayAlerts = True
  End If
End Sub

Private Function checkFileTime(ByVal strOldFile As String, ByVal strNewFile As String) As Boolean
  Dim objFSO As Object, objFile As Object
  Dim dblOldFTime As Double, dblNewFTime As Double

  If Dir(strOldFile) = "" Then Exit Function
  If Dir(strNewFile) = "" Then Exit Function

  Set objFSO = CreateObject("Scripting.FileSystemObject")

  Set objFile = objFSO.GetFile(strOldFile)
  dblOldFTime = objFile.DateLastModified

  Set objFile = objFSO.GetFile(strNewFile)
  dblNewFTime = objFile.DateLastModified

  checkFileTime = dblOldFTime > dblNewFTime

  Set objFile = Nothing
  Set objFSO = Nothing
End Function

Gruß Sepp

Hallo Sepp,
ich habe Deinen Code mal ein meine Idee angepasst, aber es funktioniert so noch nicht.
Was ist suche ist folgendes:
- User öffnet die Datei1
- Es erfolgt dann auch immer eine Zwangsspeicherung unter C:\OrdnerXY\Datei 1 (damit Updates die Datei finden können).
- Nun geht ein User hin und speichert die Datei, sagen wir unter "Datei2" irgendwo ab, denkt sich nichts dabei und schließt die Datei2 dann wieder
- Einige Zeit später arbeitet er (so wie es sein soll) mit Datei 1 weiter, die dadurch ja hinsichtlich des Änderungsdatums aktueller wird; dann schließt er die Datei wieder usw.
- Eines Tages kommt er auf die Idee seine unter "Datei2" gespeicherte Version zu öffnen, wo ja aufgrund des Makros die Zwangsspeicherung abläuft). NUN soll die Warnung erscheinen
Könntest Du den Code nochmals in diese Denkrichtung checken ?
Herzlichen Dank!
Viele Grüße
Dietmar aus Aachen
Danke für Deine Hilfe

Option Explicit
Const cstrSaveAsName As String = "C:\OrdnerXY\datei1.xls"
Private Sub Workbook_Open()
If Dir("C:\OrdnerXY\datei1.xls", vbDirectory) = "" Then
MsgBox "Ihr Abrechnungsprogramm wird wie folgt gespeichert: C:\OrdnerXY\datei1.xls",  _
vbInformation, "Hinweis"
Else
End If
Application.DisplayAlerts = False   'Nachfrage ausschalten
ActiveWorkbook.SaveAs Filename:="C:\OrdnerXY\datei1.xls"
Application.DisplayAlerts = True    'Nachfrage einschalten
Dim bSave As Boolean
bSave = True
If Dir(cstrSaveAsName) = "C:\OrdnerXY\datei1.xls" Then
If checkFileTime(cstrSaveAsName, Me.FullName) Then
bSave = MsgBox("Die Datei die Sie speichern wollen, ist älter" & vbLf & _
"als die bereits vorhandene Datei!" & vbLf & vbLf & "Wollen Sie" & _
" trotzdem fortsetzen?", vbInformation + vbYesNo + vbDefaultButton2, _
"Hinweis") = vbYes
End If
End If
If bSave Then
Application.DisplayAlerts = False
Me.SaveAs cstrSaveAsName
Application.DisplayAlerts = True
End If
End Sub
Private Function checkFileTime(ByVal strOldFile As String, ByVal strNewFile As String) As  _
Boolean
Dim objFSO As Object, objFile As Object
Dim dblOldFTime As Double, dblNewFTime As Double
If Dir(strOldFile) = "" Then Exit Function
If Dir(strNewFile) = "" Then Exit Function
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.GetFile(strOldFile)
dblOldFTime = objFile.DateLastModified
Set objFile = objFSO.GetFile(strNewFile)
dblNewFTime = objFile.DateLastModified
checkFileTime = dblOldFTime > dblNewFTime
Set objFile = Nothing
Set objFSO = Nothing
End Function

Beliebteste Forumthreads (12 Monate)

Beim "Speichern unter" Prüfung welche Datei älter

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Beim "Speichern unter" Prüfung welche Datei älter

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread