Datumswert in Dateinamen?
08.06.2021 10:12:48
Conny
ich habe einen VBA-Code für die Erstellung einzelner Word- und PDF-Dokumente aus einem umfangreichen Serienbrief geschrieben, der die einzeln erzeugten und nach Vorgabe benannten Dokumente nach bestimmten Kriterien in verschiedene Ordner (die ich per VBA zuvor aus der Excel-Quelldatei heraus erstelle) auf dem Fileserver sortiert. Der Code funktioniert auch.
Allerdings würde ich gern in die zu erzeugenden Dateinamen auch einen Datumswert integrieren (DocDatum = .DataFields("Datum_VA").Value), allerdings wird dieser Datumswert dann immer mit Slashs statt Punkten ausgewiesen, was das Speichern nicht möglich macht. Wie bekomme ich ein für Dateinamen zulässiges Datumsformat erzeugt?
(Der Code soll ein Beispiel für Office-erfahrene Kollegen sein, den sie selbst beliebig auf vergleichbare Aufgaben übertragen können sollen. Das ist hier de Aufgabenstellung)
Option Explicit
Dim DocName As String
Sub EinzelPDFsUndDocsAusSerienbrief()
Dim Dateiname As String
Dim DocName As String
Dim LetzterRec As Long
Dim strPath As String
Dim strName As String
Dim strDocument As Object
Dim DocThema As String
Dim DocDatum As String
Dim DocVorname As String
Application.ScreenUpdating = False
Application.Visible = False
Const path As String = "P:\0_ kobra.net\AG EXCEL\Projekt VBA Einzel-PDFs u. DOCs\2_Schreiben einzeln doc\"
'Pfad anpassen
ActiveDocument.MailMerge.DataSource.ActiveRecord = wdLastRecord
LetzterRec = Word.ActiveDocument.MailMerge.DataSource.ActiveRecord
ActiveDocument.MailMerge.DataSource.ActiveRecord = wdFirstRecord
With ActiveDocument.MailMerge
.DataSource.ActiveRecord = wdFirstRecord
Do
If .DataSource.ActiveRecord > 0 Then
If .DataSource.DataFields("Name").Value "0" Then
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = .ActiveRecord
.LastRecord = .ActiveRecord
'Dateiname = Path & "VA " & .DataFields("Veranstaltungsthema").Value & .DataFields("Datum_VA").Value & .DataFields("Name").Value & "_Teilnahmebescheinigung.docx"
Dateiname = path & "VA " & .DataFields("Veranstaltungsthema").Value & "_" & .DataFields("Vorname").Value & " " & .DataFields("Name").Value & "_Teilnahmebescheinigung.doc"
Dateiname = Replace(Dateiname, Chr(13), "")
DocVorname = .DataFields("Vorname").Value
DocName = .DataFields("Name").Value
DocThema = .DataFields("Veranstaltungsthema").Value
DocDatum = .DataFields("Datum_VA").Value
' MsgBox (DocName)
End With
.Execute Pause:=False
ActiveDocument.SaveAs FileName:=Dateiname 'Speichern unter Dateiname
ActiveDocument.Close False
For Each strDocument In Application.Documents
With strDocument
strPath = "P:\0_ kobra.net\AG EXCEL\Projekt VBA Einzel-PDFs u. DOCs\1_Schreiben einzeln pdf\" & "VA " & DocThema & "\"
strName = "VA " & DocThema & "_" & DocVorname & " " & DocName & " " & "_Teilnahmebescheinigung" & ".pdf"
.ExportAsFixedFormat Outputfilename:=strPath & strName, _
ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, Range:= _
wdExportAllDocument, Item:=wdExportDocumentContent, _
IncludeDocProps:=True, KeepIRM:=True, CreateBookmarks:= _
wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
End With
Next strDocument
End If
End If
If .DataSource.ActiveRecord