Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Beim "Speichern unter" Prüfung welche Datei älter | Herbers Excel-Forum


Betrifft: Beim "Speichern unter" Prüfung welche Datei älter von: Dietmar aus Aachen
Geschrieben am: 29.01.2010 10:12:45

Guten Morgen in die Runde,

meine Anfrage von gestern war vielleicht nicht deutlich genug formuliert, da mir keiner helfen konnte. Daher einfach nur etwas anders erklärt:

Wie kann ich es erreichen, dass beim Speichern einer Datei, die ich im Rahmen von "speichern unter" auf den Namen einer bereits vorhandenen Datei vornehmen möchte nicht nur die Standard-Frage gestellt wird, ob die vorhandene Datei überschrieben werden soll, sondern, dass eine Msgbox erscheint, die mir mitteilt, dass die Datei, die ich gerade speichern möchte älter ist als die vorhandene (zu überschreibende) Datei? Dann soll vbYesNo eine Wahlmöglichkeit geben.

Meine Idee war, hier eine Prüfung des Änderungsdatums (incl. Uhrzeit) beider Dateien vorzunehmen, und zwar im mit dem jeweilgien Heute-Datum (incl. Uhrzeit).

Jemand eine Idee?

Viele Grüße
Dietmar aus Aachen

  

Betrifft: AW: Beim "Speichern unter" Prüfung welche Datei älter von: Josef Ehrensberger
Geschrieben am: 29.01.2010 10:32:24

Hallo Dietmar,

das geht z.B. so.

Sub checkFileTime()
  Dim objFSO As Object, objFile As Object
  Dim strOldFile As String, strNewFile As String
  Dim dblOldFTime As Double, dblNewFTime As Double
  
  strOldFile = "C:\Datei1.xls" 'Datei die Überschrieben werden soll
  strNewFile = "C:\Datei2.xls"
  
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  
  Set objFile = objFSO.GetFile(strOldFile)
  dblOldFTime = objFile.DateLastModified
  
  Set objFile = objFSO.GetFile(strNewFile)
  dblNewFTime = objFile.DateLastModified
  
  If dblOldFTime > dblNewFTime Then
    MsgBox "Datei " & strOldFile & " ist neuer als " & strNewFile
  End If
  
  Set objFile = Nothing
  Set objFSO = Nothing
End Sub



Gruß Sepp



  

Betrifft: Hallo Sepp, das passt schon fast von: Dietmar aus Aachen
Geschrieben am: 29.01.2010 13:03:22

Hallo Sepp,

vielen Dank, das sieht gut aus und Du hast auch richtig verstanden, was ich meinte.

Wobei ich mir überlegen muss, wie ich den Code anpasse, damit er in meine Zwangsspeicherroutine reinpasst, die ich unter Workbook_Open hinterlegt habe und wie ich eine Variable reinbastele, so dass die aktuell zu öffnende Datei diejenige ist, die in die Prüfungsroutine kommt, ob sie die Datei 1 überschreiben darf.
Mit dem vorgegebenen Pfad für die Datei2 (neue Datei) werde ich nicht klarkommen, da nur der Speicherort der Datei1 bekannt ist.

Zum Verständnis:
a) Datei 1 und Datei 2 sind vom Aufbau her und den hinterlegten Makros identisch

b)Datei 1 liegt auf C:\ und soll grundsätzlich auch dort bleiben, und damit wird gearbeitet. Immer wenn diese geöffnet wird, speichert sie sich selbständig auf C:\ ab. Da muss so sein, damit der User keinen anderen Speicherort wählt (meine Updates suchen Datei 1 immer nur an dieser Stelle, und laufen dann ab), Soweit so gut.

c)Datei2 wurde beispielsweise auf einen Stick kopiert und verbeibt dort. Tage oder Stunden später:(Zwischenzeitlich wurde mit Datei 1 weitergearbeitet und es wurden Veränderungen vorgenommen). Jetzt plötzlich kommt der User auf die Idee die Datei2 vom Stick aus zu öffnen. Es läuft wieder automatsich die Workbook_Open_Speicherroutine ab. Und jetzt (!) soll die Prüfiung stattfinden, ob das erlaubt werden soll.

Danke für Deine Hilfe!

Viele Grüße
Dietmar aus Aachen


  

Betrifft: AW: Hallo Sepp, das passt schon fast von: Meene
Geschrieben am: 29.01.2010 13:15:15

... mit ActiveWorkbook.Path kommst Du nach dem Öffnen an den Pfad der Datei2!

Gruß,
Michael


  

Betrifft: AW: Hallo Sepp, das passt schon fast von: Josef Ehrensberger
Geschrieben am: 29.01.2010 15:32:39

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



  

Betrifft: Hallo Sepp, nein so gehts leider nicht von: Dietmar aus Aachen
Geschrieben am: 02.02.2010 08:21:52

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



  

Betrifft: AW: Beim "Speichern unter" Prüfung welche Datei älter von: Gert Seler
Geschrieben am: 29.01.2010 10:38:36

Hallo Dietmar,
sobald eine "Datei" geöffnet und wieder gespeichert wird, erhält die "Datei" automatisch
einen neuen Zeitstempel.
Das heißt, eine Datei die gespeichert wird, kann nie älter sein als eine Datei, die zur Zeit
"ungeöffnet" im Verzeichnis ausgewiesen wird. Mit "speichern unter" werden nur "neue"
Dateien gespeichert, die noch keinen Namen haben oder existierende Dateien, welche
einen anderen Namen bzw z.B. als "Vorlage" (*.xlt; csv; txt) gesichert werden sollen.

mfg
Gert




  

Betrifft: AW: Beim "Speichern unter" Prüfung welche Datei älter von: Dietmar aus Aachen
Geschrieben am: 29.01.2010 13:07:11

Hallo Gert,

vielen Dank für Deine Rückmeldung. Das habe ich soweit verstanden. Aber schau mal in die Anwort rein, die ich Sepp geschreiben habe.
Das erläutert meine Fragestellung noch ein wenig besser.

Viele Grüße
Dietmar aus Aachen


Beiträge aus den Excel-Beispielen zum Thema "Beim "Speichern unter" Prüfung welche Datei älter"