Hallo zusammen,
ich habe ein Problem und werde leider weder im Forum, noch bei Dr. Google fündig.
Ich bin VBA Autodidakt und noch ziemlicher Laie mit Lust am Basteln.
Ich nutze zum Schreiben von wöchentlichen Protokollen eine Word Datei als Vorlage (Office 2013, Windows 10 Pro).
am Ende des Schreibvorgangs habe ich mir in meiner äußerst Laienhaften Art einen Commandbutton zusammengebastelt.
Dieser sollte das Dokument drucken und unter einem definierten Namen incl. aktuellem Datum speichern. (Protokoll Teambesprechung_yyyy_mm_dd)
Soweit würde ich das auch hinbekommen.
Mein Problem ist nun folgendes:
In meiner Abwesenheit wird das Protokoll von einem Kollegen geschrieben, welcher computertechnisch nicht firm ist und manchmal zwei Protokolle an einem Tag schreibt und dann natürlich das alte Protokoll überschreibt.
Die Lösung die Uhrzeit mit in den Namen zu integrieren habe ich schon im Netz gefunden. Dies macht jedoch die Übersicht etwas schwiriger.
Meine Frage ist nun Folgende:
Gibt es eine Möglichkeit eine VBA so zu programmieren, dass geprüft wird, ob der Dateiname besteht und gegebenenfalls die Datei über eine Art Counter zu modifizieren um das Überschreiben zu verhindern?
Ich habe lange im Netz gesuch und mir folgenden Code zusammengebastelt:
---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Option Explicit
Sub Speichern_unter()
Dim strFileName As String
strFileName = NextFileIndexName("U:\Eigene Dateien\BEARBEITUNG\Protokoll", "Protokoll Teambesprechung_" & Format(Date, "yyyy_mm_dd") & " (($)).docx", "0", 1)
If Len(strFileName) Then ActiveDocument.SaveAs2 strFileName
End Sub
Private Function NextFileIndexName(ByVal FilePath As String, ByVal FileNamePattern As String, Optional ByVal IndexFormat As _
String = "-0", Optional ByVal StartIndex As Long = 0, Optional ByVal ShowNullIndex As Boolean = True) As String
'PARAMETERINFO:
'FilePath = Directory where the file is or should be located.
'FileNamePattern = Filename where '($)' marks the position of index-number!
'IndexFormat = The desired Format of the indexnumber.
'StartIndex = Lower bound of the indexnumber.
'ShowNullIndex = If true, the index '0' will be shown in the filename.
Dim varFile As Variant, strCheck As String, strIndex As String, strTemp As String, lngIndex As Long
Const PLACEHOLDER As String = "($)"
On Error GoTo ErrorHandler
If InStr(1, FileNamePattern, PLACEHOLDER) = 0 Then GoTo ErrorHandler
If Len(FileNamePattern) <> Len(Replace(FileNamePattern, PLACEHOLDER, "")) + Len(PLACEHOLDER) Then GoTo ErrorHandler
If Dir(FilePath, vbDirectory) = "" Then GoTo ErrorHandler
If Right(FilePath, 1) <> "\" Then FilePath = FilePath & "\"
varFile = Split(FileNamePattern, PLACEHOLDER)
lngIndex = StartIndex
Do
If lngIndex = 0 And ShowNullIndex Then
strIndex = Format(lngIndex, IndexFormat)
ElseIf lngIndex > 0 Then
strIndex = Format(lngIndex, IndexFormat)
End If
lngIndex = lngIndex + 1
strTemp = FilePath & varFile(0) & strIndex & varFile(1)
strCheck = Dir(strTemp, vbNormal)
Loop Until strCheck = ""
NextFileIndexName = strTemp
Exit Function
ErrorHandler:
NextFileIndexName = ""
End Function
---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Die Vorlage basierend auf Excel habe ich aus dem Netz und es war auch eine Funktion zum Speichern der Vorlage integriert. Dies habe ich herausgelöscht.
Orginal hat die Formel so begonnen
Option Explicit
Sub saveCopy()
Dim strFileName As String
strFileName = NextFileIndexName("C:\Dokumente\", "Datei_" & Format(Date, "yyyymmdd") & "_($).xlsm", "00", 1)
ThisWorkbook.Save
If Len(strFileName) Then ThisWorkbook.SaveAs strFileName
End Sub
Wenn ich nun aber mein Makro aufrufe, wird die Datei zwar gespeichert und der Counter funktioniert, die Dateien lassen sich aber nicht mehr öffnen.
Es erscheint in Word die Fehlermeldung:
Leider kann "Protokoll Teambesprechung[...].docx" nicht geöffnet werden, da der Inhalt Probleme verursacht.
Details
keine Fehlerdetails verfügbar
Leider reichen meine Kenntnisse nicht aus um den Fehler zu detektieren.
Über Hilfe wäre ich sehr dankbar.
Vielen Dank schonmal im Voraus und danke für das tolle Forum.
Liebe Grüße
|