VBA Word 2010 Ordner auf Teilstring yyyymmdd hhmm prüfen mit aktueller Uhrzeit now vergleichen und falls vorhanden eine msgbox ausgeben

Hallo,

ich lasse in Word ein Formular über einen Button als PDF unter bestimmten Namen speichern.
Diese Prüfung kann an unterschiedlichen PC stattfinden.

Dim filename As String
  Dim filenameemailtext As String
  Dim sVar As String
  sVar = ActiveDocument.FormFields("Dropdown1").Result  
 
  If sVar = " " Then  
  MsgBox "Bitte 'Prüfung wurde durchgeführt durch' auswählen", vbCritical, "geprüft durch.."  
  Exit Sub
  Else
  
  filename = "x:\as400\" & "Systemprüfung_AS400_" & Format(Now, "yyyymmdd_hhmm") & "_" & sVar & ".pdf"  
  filenameemailtext = "Systemprüfung_AS400_" & Format(Now, "yyyymmdd_hhmm") & "_" & sVar & ".pdf"  
  

ActiveDocument.ExportAsFixedFormat OutputFileName:=filename, _
                                   ExportFormat:=wdExportFormatPDF, _
                                   OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, Range:= _
                                   wdExportAllDocument, Item:=wdExportDocumentContent, _
                                   IncludeDocProps:=True, KeepIRM:=True, CreateBookmarks:= _
                                   wdExportCreateNoBookmarks, DocStructureTags:=True, _
                                   BitmapMissingFonts:=True, UseISO19005_1:=False
MsgBox "Datei wurde unter Pfad und Dateinamen " & filename & " gespeichert. Dieses Formular wird ohne Speicherung des Inhalt geschlossen.", vbInformation, filenameemailtext  

'leeren der Eingegeben Felder  
   If ActiveDocument.ProtectionType = wdAllowOnlyFormFields Then
        ActiveDocument.Unprotect Password:=""  
        ActiveDocument.ResetFormFields
        ActiveDocument.Protect Password:="", Type:=wdAllowOnlyFormFields, NoReset:=False  
    End If


'ActiveDocument.Application.Quit savechanges = False  
End If
End Sub

nun möchte ich aber beim speichern prüfen ob bereits eine Datei mit heutigem Datum Teilstring im Dateinamen yyyymmdd vorhanden ist. Ideal wäre sogar noch die UhrzeitTeilstrin im Dateinamen hhmm in die Prüfung einfließen zu lassen.
Hintergrund : dieses Formular muss zu bestimmten Uhrzeiten ausgefüllt werden. Einmal nach 9.00 und einmal nach 14.00. Daher soll eine Prüfung stattfinden ob bereits ein Dokument vom heutigen Datum ab 9.00 erstellt wurde und falls es nach 14.00 ist, ob bereits ein Dokument davon existiert und dieses als Warnhinweis anzeigen.

Vielleicht kann mir hier jemand weiter helfen

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 353557

Url: https://administrator.de/forum/vba-word-2010-ordner-auf-teilstring-yyyymmdd-hhmm-pruefen-mit-aktueller-uhrzeit-now-vergleichen-und-falls-353557.html

Ausgedruckt am: 23.12.2024 um 01:12 Uhr

5 Kommentare

Neuester Kommentar

Naja überprüfen ob bestimmte Datei existiert hätte man auch selbst nachschlagen können...

Set fso = CreateObject("Scripting.FilesystemObject")  
For each file in fso.GetFolder("c:\Pfad").Files  
    if Instr(1,file.Name, Format(Now, "yyyymmdd_hhmm"),1) > 0 then  
         MsgBox "Datei bereits vorhanden!", vbExclamation  
         Exit for
    End if
Next

https://msdn.microsoft.com/de-de/library/8460tsh1(v=vs.90).aspx

Mir geht es nicht um eine einfache Dateiprüfung sondern um einen Teilstring des Dateinamens Format(Now, "yyyymmdd_hhmm")
Hier soll geprüft werden ob eine Datei vom Namen mit dem Teilstring Format(Now, "yyyymmdd_hhmm") z.b. 03112017_1004 vorhanden ist , da dieses Formular zu bestimmten Uhrzeiten ausgefüllt wird. Einmal nach 9.00 und einmal nach 14.00. Daher soll eine Prüfung stattfinden ob bereits ein Dokument vom heutigen Datum ab 0900 erstellt wurde und falls es nach 14.00 ist, ob bereits ein Dokument ab 1400 davon existiert und ich dachte dieses anhand des Dateinamens zu prüfen, da hier im String bereits Datum und Uhrzeit im Format vorhanden ist.

Set fso = CreateObject("Scripting.FilesystemObject")  
set Regex = CreateObject("vbscript.regexp")  
Regex.pattern = format(date, "yyyymmdd") & "_\d{4}"  

For each file in fso.GetFolder("c:\Pfad").Files  
    if Regex.test(file.Name) Then
       If  (Hour(Now) < 14 and Hour(file.DateCreated) < 14) or (Hour(Now) >=14 and Hour(file.DateCreated) >=14) then
         MsgBox "Datei bereits vorhanden!", vbExclamation  
         Exit for
       End if
    End if
Next

Hallo leider läuft das Script ohne eine gefundene Dateien durch

Im Ordner liegen aktuell folgende Test Dateien

x:\as400\asp.zip
x:\as400\Systemprüfung_AS400_20171103_1044_xxxxx.pdf
x:\as400\Systemprüfung_AS400_20171103_1045_xx.pdf

hätte hier das Script nicht 2x erkennen müssen das Dateien von 10:44 vorhanden sind?

Über Stopper springt er zwar auf If Regex.test(file.Name) Then aber nicht weiter auf den nächsten IF Block