| Sub Initialize |
| |
| Dim CurrentSession As New notessession |
| Dim db As notesdatabase |
| Dim docsel As NotesDocumentCollection |
| Dim doc As NotesDocument |
| Dim rtitem As Variant |
| Dim Attpath As String |
| Dim Attpath_Master As String |
| Dim Attpath_date As String |
| Dim Attsubject As Variant |
| Dim BerichtsName As String |
| Dim Verzeichnisse As String |
| Dim VzCreate_date As Boolean |
| Dim VzCreate_bericht As Boolean |
| |
| Set db = CurrentSession.CurrentDatabase |
| Set docsel = db.UnprocessedDocuments |
| |
| Attpath = "\\z-dom-01\s$\Z_Daten\" 'Wichtig immer mit \ abschließen |
| Attpath_date = Date 'aktuelles Systemdatum um Unterordner zu erstellen; evt. mit Format-Function anders formatieren |
| Attpath_master = Attpath & Attpath_date & "\" 'setzt Pfad mit Unterordner (Datum) zusammen |
| |
| 'Überprüfung ob Ordner (Datum) vorhanden ist |
| VzCreate_date = True |
| Verzeichnisse$ = Dir$(Attpath,16) |
| Do While Verzeichnisse$ <> "" |
| Verzeichnisse$ = Dir$() |
| If Instr( Verzeichnisse$, Attpath_date ) = 1 Then |
| VzCreate_date = False |
| Exit Do |
| End If |
| Loop |
| |
| 'wenn nicht vorhanden oberste Ebene des Ordners (Datum) erstellen |
| If VzCreate_date Then |
| 'Msgbox "Ordner (Datum) erstellt" |
| Mkdir Attpath_master 'oberste Ebene des Ordners (Datum) |
| Else |
| 'Msgbox "Ordner (Datum) nicht erstellt" |
| End If |
| |
| Set doc = docsel.Getfirstdocument |
| While Not doc Is Nothing |
| Set rtitem = doc.GetFirstItem( "Body" ) |
| |
| Set Attsubject = doc.GetFirstItem( "Subject" ) |
| Forall v In Attsubject.Values |
| BerichtsName = Trim$(Strright(v, "|" )) |
| Attpath = Attpath_master & BerichtsName & "\" |
| |
| 'Überprüfung ob Unterordner (Bericht) vorhanden ist |
| VzCreate_bericht = True |
| Verzeichnisse$ = Dir$(Attpath_master,16) |
| Do While Verzeichnisse$ <> "" |
| Verzeichnisse$ = Dir$() |
| If Instr( Verzeichnisse$, BerichtsName ) = 1 Then |
| VzCreate_bericht = False |
| Exit Do |
| End If |
| Loop |
| |
| 'wenn nicht vorhanden untere Ebende des Ordners (Bericht) erstellen |
| If VzCreate_bericht Then |
| 'Msgbox "Unterordner erstellt" |
| Mkdir Attpath 'Unterordner (Datum) |
| Else |
| 'Msgbox "Unterordner nicht erstellt" |
| End If |
| |
| 'Attachment lösen |
| If ( rtitem.Type = RICHTEXT ) Then |
| Forall o In rtitem.EmbeddedObjects |
| If ( o.Type = EMBED_ATTACHMENT ) Then |
| Call o.ExtractFile( Attpath & o.Source ) |
| 'Call o.Remove 'Attachment löschen |
| 'Call doc.Save( False, True ) 'Dokument speichern |
| End If |
| End Forall |
| End If |
| |
| Attpath = Attpath_Master 'Variable zurücksetzen auf den Oberordner (Datum) |
| Set doc = docsel.Getnextdocument(doc) |
| |
| End Forall |
| |
| Wend |
| |
| End Sub |