Thema Datum  Von Nutzer Rating
Antwort
Rot Word VBA speichern unter ohne überschreiben
28.02.2022 08:56:13 Physio80
NotSolved
07.03.2022 09:45:36 Gast98806
Solved

Ansicht des Beitrags:
Von:
Physio80
Datum:
28.02.2022 08:56:13
Views:
1059
Rating: Antwort:
  Ja
Thema:
Word VBA speichern unter ohne überschreiben

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


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Word VBA speichern unter ohne überschreiben
28.02.2022 08:56:13 Physio80
NotSolved
07.03.2022 09:45:36 Gast98806
Solved