Macro ausführen
11.10.2020 01:53:29
Thomas
ich habe eine Exceldatei (arbeits.xlsm) die mehrmals am Tag geöffnet wird. ( schreibgeschützt)
Einmal in der Woche soll beim öffnen der Datei erst noch ein Makro gestartet werden.
Sub Workbook_Open()
call testmacro
End Sub
Deshalb habe ich mir gedacht, ich benutze eine weitere Exceldatei in der das Datum ( letztes Ausführungsdatum vom call testmacro) in der Bezeichnung enthalten ist. z.B. (mill_20201011.xlsm) . Beim öffnen der arbeits.xlsm wird das Datum in der Bezeichnung dann geprüft ob das testmacro diese Woche schon ausgeführt wurde.
Das Macro habe ich fertig und es funktioniert schon ganz gut.
Mein Problem ist sobald wenn jemand meine Exceldatei z.B. mill_20201011.xlsm löscht funktioniert das ganze natürlich nicht mehr.
Ich schaffe es einfach nicht diesen möglichen Fehler abzufangen. Mein Versuch eine neue Exceldatei mit den Name "mill_.xls" zu erstellen funktioniert einfach nicht. Ich erhalte beim ersten Start immer den Fehler " Fehler beim Zugriff auf Datei und Pfad".
Wenn ich diesen Fehler bestätige und meine Datei das zweite mal öffne funktioniert es ohne Fehlermeldung.
Hat jemand einen Rat für mich?.
Vielleicht weiß auch jemand eine Möglichkeit dies leichter zu machen. Vielleicht mit einer Textdatei in der das ausführungsdatum protokolliert und dann verglichen wird.
mfg thomas
Sub neumappe()
Application.ScreenUpdating = False
Dim strTmpPath As String
Dim strTmpName As String
strTmpPath = "c:\test\"
strTmpName = "mill_.xls"
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=strTmpPath & strTmpName
ActiveWorkbook.Close
End Sub
Private
Sub CommandButton1_Click()
Dim s$
'Const Pfad = "c:\test\"
Const Datei = "mill_*.*"
Const Pfad As String = "c:\test\"
'prüfen ob datei existieren
s = Dir(Pfad & Datei)
If Len(s) > 0 Then
MsgBox " Datei ist da "
s = Dir(Pfad & Datei)
Else
'falls nicht bitte erstellen
Call neumappe
' MsgBox " Datei fehlt"
End If
Dim DateiName As String, Endung As String, BackupDatei As String
If Weekday(Date, vbMonday) = 7 Then 'hier den tag einstellen
' wenn montag ist
'dateiname ohne endung
DateiName = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1)
Endung = ".xls" 'Mid(ThisWorkbook.Name, Len(DateiName) + 1) '".xls
BackupDatei = DateiName & "_" & Format(Date, "YYYYMMDD") & Endung
If Dir(Pfad & BackupDatei) = "" Then
'Datei umbenennen
Name s As BackupDatei
'call testmacro
' ThisWorkbook.SaveCopyAs Pfad & BackupDatei
Else
'ThisWorkbook.SaveCopyAs Pfad & BackupDatei
'datei schon gebackupt
End If
End If