Speicher ohne Rückfrage

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub cmdBeenden_Click() Dim Speicherdatum As Date Dim Speichername As String Dim sPfad As String 'Kombination: speichern = ja und schreibgeschutzt nicht erlaubt. Muss man dafür Excel komplett schliessen (Application.Quit)? If MsgBox("SPEICHERN, schreibgeschützt??", vbQuestion + vbYesNo + vbDefaultButton2, "Message Box Titel") = vbYes And ActiveWorkbook.ReadOnly Then Application.DisplayAlerts = False Application.Quit End If Speicherdatum = DateValue(ActiveWorkbook.BuiltinDocumentProperties("last save time")) If CDate(Sheets("Tabelle1").Range("Y1").Value) = Speicherdatum Then With ThisWorkbook sPfad = .FullName SetAttr PathName:=.FullName, Attributes:=vbNormal .Saved = True If .ReadOnly Then .ChangeFileAccess Mode:=xlReadWrite Application.Dialogs(xlDialogSaveAs).Show Left(.FullName, Len(.FullName) - 13) & Format(Speicherdatum, "YYYYMMDD") & ".xlsm" End With Speicherdatum = Left(ActiveWorkbook.BuiltinDocumentProperties("last save time"), 10) Else ThisWorkbook.SaveAs Filename:="d:\Excel\Allgemein\Dateiname" & Format(Speicherdatum, "YYYYMMDD") & ".xlsm" End If ActiveSheet.Unprotect Speicherdatum = ParseDate(Left(Right(ThisWorkbook.Name, 13), 10)) Sheets("Tabelle1").Range("Y1").Value = CStr(Speicherdatum) ActiveSheet.Protect Application.DisplayAlerts = False ThisWorkbook.Save 'wozu das? With CreateObject("Scripting.FileSystemObject").GetFile(ActiveWorkbook.FullName) .Attributes = .Attributes + 1 End With Application.DisplayAlerts = True Application.Quit End Sub Public Function ParseDate(ByVal DatumYYYYMMDD As String) As Date ParseDate = DateSerial(Left(DatumYYYYMMDD, 4), Mid(DatumYYYYMMDD, 5, 2), Right(DatumYYYYMMDD, 2)) End Function

hallo Yal,

du schreibst, "mein Code beinhaltet einige nutzlose Sachen". Aus deiner Sicht hast du vielleicht recht. Der von mir benutzte Code basiert teilweise auf Vorschlägen aus diesem Forum; ich würde diese Unterstützer nicht unbedingt als VBA-Anfänger betrachten. Ich habe schon öfters erlebt dass man auf unterschiedlichen VBA-Wegen eine Lösung erarbeiten kann.

ich habe deinen Vorschlag getestet. Dabei fiel mir auf, das es in Zeile 7 anstatt vbyes "vbNo" heißen muss, wenn die Datei Abfrage mit "Ja" (Speichern) beantwortet wird.

If MsgBox("SPEICHERN, schreibgeschützt??", vbQuestion + vbYesNo + vbDefaultButton2, "Message Box Titel") = vbYes And ActiveWorkbook.ReadOnly Then

If MsgBox("SPEICHERN, schreibgeschützt??", vbQuestion + vbYesNo + vbDefaultButton2, "Message Box Titel") = vbNo And ActiveWorkbook.ReadOnly Then

Bezüglich des folgenden Speichern-Dialogs verweise ich auf die Problembeschreibung in meiner Anfrage vom 19.06.2023 16:49:29

Dort heißt es:

Es geht mir jetzt noch um ein Detail bei Möglichkeit "3".
In Zeile 37 des VBA-Editors wird das Dialogfeld "Speichern unter...." geöffnet und der vorhandene Dateiname vorgeschlagen. Bei Betätigung der Schaltfläche "Speichern" erscheint das Meldungsfenster "Speichern unter bestätigen" mit dem Hinweis, das der gewünschte Dateiname bereits vorhanden ist. "Möchten Sie sie ersetzen?" Bei Betätigung der Schaltfläche "Ja" wird die Datei unter dem genannten Dateinamen ohne weitere Rückfrage gespeichert und -wie gewünscht- geschlossen.
Meine Frage an das Forum lautet: Kann das Meldungsfenster "Speichern unter bestätigen" verhindert werden, sodass der Speichervorgang direkt eingeleitet wird.

Ich kann leider nicht erkennen, dass du dieses Problem berücksichtigt hast.

Ist die Ermittlung des Speicherdatums mit "ParseDate" sinnvoll, zunal dein Code nicht funktioniert?

'wozu das?
    With CreateObject("Scripting.FileSystemObject").GetFile(ActiveWorkbook.FullName)
        .Attributes = .Attributes + 1
    End With

Damit wird dei Datei abschließend mit dem Attribut "Schreibschutz" versehen

Leider hilft mir dein Beitrag überhaupt nicht weiter, zumal ich am 19.06.2023 16:49:29 bereits die Frage zurückgezogen habe, weil ich inzwischen selbst eine funktionierende lösung erarbeitet hatte.
Trotzdem Danke für deine Mühe
reiner

Hallo Reiner,

Du kannst prüfen, ob die Datei existiert und wenn ja löschen, dann speichern:

Sub Datei_speichern(Dateiname As String)
Dim F As Object 'File-Objekt

    With CreateObject("Scripting.FileSystemObject")
        Set F = .GetFile(Dateiname)
        If Not F Is Nothing Then .DeleteFile Dateiname
    End With
    ThisWorkbook.SaveAs Dateiname
End Sub

oder kürzer:

Kill Dateiname
ThisWorkbook.SaveAs Dateiname

Das Setzen des ReadOnly kann auch so erreicht werden:

SetAttr Dateiname, vbReadOnly

Ist gleichwertig, aber bei Lesen sofort zu -wieder- verstehen.

Es ist nicht "ParseDate", das nicht funktioniert sondern das Datum wurde nicht in der Form YYYYMMDD übergeben:
Du hast einmal DD.MM.YYYY

      Jahr = Right(Date, 4)
      Monat = Mid(Date, 4, 2)
      Tag = Mid(Date, 1, 2)

und einmal YYYYMMDD

      Jahr = Left(Speicherdatum, 4)
      Monat = Mid(Speicherdatum, 5, 2)
      Tag = Mid(Speicherdatum, 7, 2)

Dementsprechend könntest Du versuchen eine "ParseDateDD_MM_YYYY" zu programmieren (das aktuelle ParseDate wäre dann "ParseDateYYYYMMDD")

Sub test()
    MsgBox ParseDate("20230621")
    MsgBox ParseDate("20230631") 'existiert nicht, wird trotzdem als 01.07.2023 interpretiert
End Sub

Public Function ParseDate(ByVal DatumYYYYMMDD As String) As Date
    ParseDate = DateSerial(Left(DatumYYYYMMDD, 4), Mid(DatumYYYYMMDD, 5, 2), Right(DatumYYYYMMDD, 2))
End Function

Ein universelle ParseDate könnte so aussehen:

Sub test()
    MsgBox ParseDate("20230621", "YYYYMMDD")
    MsgBox ParseDate("36.13.21", "DD.MM.YY")
End Sub

Public Function ParseDate(ByVal Datum As String, Muster As String) As Date
Dim i
Dim D, M, Y
    For i = 1 To Len(Muster)
        Select Case UCase(Mid(Muster, i, 1))
        Case "Y": Y = Y & Mid(Datum, i, 1)
        Case "M": M = M & Mid(Datum, i, 1)
        Case "D": D = D & Mid(Datum, i, 1)
        End Select
    Next
    ParseDate = DateSerial(CInt(Y), CInt(M), CInt(D))
End Function

VG
Yal

Beliebteste Forumthreads (12 Monate)

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread