AW: KORREKTUR: Link zu PDF-Datei erstellen
08.12.2019 11:28:37
Michael
Hallo Henner,
meine Arbeitsmappe wird mit einem Makro stündlich gespeichert und zusätzlich eine Kopie im Archiv Ordner abgelegt. Wenn ich dieses Makro auskommentiere dann funktioniert es.
Option Private Module 'damit die Prozeduren nicht von außerhalb dieser Datei aufgerufen werden können
Public taktzeit 'permanente Variable der Prozedur "Takt"
Public Sub Speichern() 'der aktuelle Stand wird im Verzeichnis Arbeitspfad und (mit Zeitstempel) _
im Verzeichnis Sicherungspfad gespeichert
Dim aktpfad As String
Dim Datpfad As String
With ThisWorkbook.Sheets("BPS_MF_Buch")
arbpfad = "X:\B\02_Produktion\BPB_S_X\BPS_Schichtprotokolle_Tagesberichte"
sichpfad = "X:\B\02_Produktion\BPB_S_X\BPS_Schichtprotokolle_Tagesberichte\ _
Archiv_MF_Buch_BPS"
Set fs = CreateObject("Scripting.FileSystemObject") 'damit man die Dateizugriffsfunktionen _
nutzen kann
If Not fs.folderexists(arbpfad) Then
MsgBox ("Arbeitspfad " & Chr(10) & arbpfad & Chr(10) & "existiert nicht!")
GoTo EndeSub
Else
If Not Right(arbpfad, 1) = "\" Then
arbpfad = arbpfad & "\"
End If
End If
If Not fs.folderexists(sichpfad) Then
MsgBox ("Sicherungspfad " & Chr(10) & sichpfad & Chr(10) & "existiert nicht!")
GoTo EndeSub
Else
If Not Right(sichpfad, 1) = "\" Then
sichpfad = sichpfad & "\"
End If
End If
Application.DisplayAlerts = False
ThisWorkbook.SaveCopyAs sichpfad & fs.GetBasename(ThisWorkbook.Name) & "_" & Year(Date) & " _
_" & Format(Month(Date), "00") _
& "_" & Format(Day(Date), "00") & "_" & Format(Hour(Time), "00") & "_" & Format(Minute(Time) _
, "00") & "." & fs.GetExtensionname(ThisWorkbook.Name)
Application.DisplayAlerts = True
aktpfad = CurDir
Datpfad = ThisWorkbook.Path & "\"
On Error GoTo EndeSub
If Datpfad = arbpfad Then
Application.EnableEvents = False 'damit diese Prozedur nicht noch einmal durch sich _
selbst aufgerufen wir
Application.DisplayAlerts = False
ThisWorkbook.Save
Application.DisplayAlerts = True
Application.EnableEvents = True
Else
Application.EnableEvents = False 'damit diese Prozedur nicht noch einmal durch sich _
selbst aufgerufen wir
Application.DisplayAlerts = False
ThisWorkbook.SaveAs arbpfad & ThisWorkbook.Name
Application.DisplayAlerts = True
Application.EnableEvents = True
End If
On Error Resume Next
End With
EndeSub:
Application.EnableEvents = True
Set fs = Nothing
End Sub
Public Sub TaktStarten() 'Softwarestand: 13.12.2016
'liest die Taktfrequemnz in [min] aus EinstellungenSpeicherfrequenz und startet einen Takt zum _
Zeitpunkt Jetzt + Taktfrequenz
Dim taktfreq As Byte
Dim std As Date
Dim Min As Date
Dim taktzeit As Date
taktfreq = ("60")
std = taktfreq \ 60
Min = taktfreq - std * 60
taktzeit = Now() + TimeValue(Format(std, "00") & ":" & Format(Min, "00") & ":00")
Application.OnTime taktzeit, "Takt", Schedule:=True
End Sub
'TaktStarten
Public Sub TaktStoppen() 'Softwarestand: 13.12.2016
On Error Resume Next
Application.OnTime taktzeit, "Takt", Schedule:=False 'Takt stoppen, falls er noch läuft
On Error GoTo 0
End Sub
'TaktStoppen
Public Sub Takt() 'Softwarestand: 13.12.2016
'Für diese Routine sind folgende globale Variablen notwendig:
'- taktzeit
'Taktfunktion:
'speichert die Datei und eine Sicherubngskopie (mit Zeitstempel) und startet den Takt neu
'Erzeugt durch Rekursivaufruf von sich selbst einen Takt mit "taktzeit" in [min]
Call TaktStoppen
Application.EnableCancelKey = xlDisabled 'damit die ESC-Taste nicht zu einem Abbruch führt, _
wenn sie während dieser Routine gedrückt wird
On Error Resume Next
aktwbname = ActiveWorkbook.Name
On Error GoTo 0
Datei = ThisWorkbook.Name
If Datei aktwbname Then
GoTo EndeSub
End If
Call Speichern
EndeSub:
Call TaktStarten 'ruft sich selbst wieder auf, um einen kontinuierlichen Takt zu erzeugen
End Sub