yoo, da hab ich was.
hab momentan hier nur den Code; die Designelemente muß ich danach noch zusammenfummeln.
Du kannst damit beliebige Dateien eines Verzeichnisses entweder
- 1 Doc pro Datei
- alle files in ein doc
importieren lassen.
ich schaue nachher mal nach dem Rest
'==========================================================================================
' C L A S S "recursionManager"
'==========================================================================================
Public Class recursionManager
Private m_ws As NotesUIWorkSpace
Private m_ses As NotesSession
Private m_db As NotesDatabase
Private m_currentPath As String
Private m_fileSpecs As Variant
Private m_recurse As Variant
Private m_SingleDoc As Variant
' Private dummy As NotesItem
Private Function getImportRules As Variant
Dim doc As NotesDocument
Set doc = Me.m_db.CreateDocument
'continue = Me.m_ws.DialogBox("DefaultDialog", True, True, False, False, False, False, "Import Rules", doc) = -1
continue = Me.m_ws.DialogBox("($ImportRules)", True, True, False, False, False, False, "Import Rules", doc) = -1
If continue Then
Me.m_currentPath = doc.startPath(0)
Me.m_fileSpecs = doc.fileSpecs
Me.m_recurse = doc.canRecurse(0) = "1"
Me.m_SingleDoc = doc.OneDocument(0)="1"
If Right$(Me.m_currentPath, 1) <> "\" Then Me.m_currentPath = Me.m_currentPath & "\"
End If
getImportRules = continue
End Function
Private Function processDirectory (currentPath$) As Variant
Dim doc As NotesDocument
Dim rtitem As NotesRichTextItem
Dim object As NotesEmbeddedObject
Dim Item As NotesItem
Dim fileList List As String
Dim importList List As String
Dim dirList List As String
Dim pb As New LNProgressBar(True)
Dim i As Long, x As Long
Call pb.SetText("Dateien importieren","Durchsuche: " & currentPath$)
x = 0
If Me.m_recurse Then
fileName$ = Dir$(currentPath$ & "*.*", 0)
Do While fileName$ <> ""
fileList(fileName$) = fileName$
fileName$ = Dir$()
Loop
fileName$ = Dir$(currentPath$ & "*", 16)
Do While fileName$ <> ""
If Left$(fileName$, 1) <> "." And Not Iselement(fileList(fileName$)) Then dirList(fileName$) = fileName$
fileName$ = Dir$()
Loop
End If
Forall fS In Me.m_fileSpecs
fileName$ = Dir$(currentPath$ & fS, 0)
Do While fileName$ <> ""
importList(fileName$) = fileName$
fileName$ = Dir$()
Print FileName$
x = x +1
Loop
End Forall
Call pb.SetProgressRange(x)
If m_SingleDoc Then
i = 1
Forall iL In importList
Set doc = Me.m_db.CreateDocument
Set rtitem = New NotesRichTextItem(doc, "Body")
Set object = rtitem.EmbedObject(EMBED_ATTACHMENT, "", currentPath$ & iL, "")
Call pb.SetProgressPos(i)
'doc.objPath = currentPath$
doc.Form = "FileImport"
doc.Subject = currentPath$ + iL
Call doc.Save(True, True, True)
i = i +1
End Forall
Else
Set doc = Me.m_db.CreateDocument
i = 1
Forall iL In importList
Set rtitem = New NotesRichTextItem(doc, "Body")
Set object = rtitem.EmbedObject(EMBED_ATTACHMENT, "", currentPath$ & iL, "")
' doc.objPath = currentPath$
' Set dummy = doc.ReplaceItemValue ( objPath , CurrentPath$ )
' Set Item = doc.ReplaceItemValue ( Form , "Fileimport" )
' Set Item = doc.ReplaceItemValue ( AttFileName , iL )
Call pb.SetProgressPos(i)
i = i +1
End Forall
'doc.Form = "FileImport"
'doc.Subject = "Datenimport"
Call doc.Save(True, True, True)
End If
If Me.m_recurse Then
Forall dL In dirList
newPath$ = currentPath$ & dL
If Right$(newPath$, 1) <> "\" Then newPath$ = newPath$ & "\"
Call processDirectory(newPath$)
End Forall
End If
Delete pb
End Function
Public Function run As Variant
continue = getImportRules
If continue Then Call processDirectory(Me.m_currentPath)
run = continue
End Function
Sub new
Set Me.m_ws = New NotesUIWorkSpace
Set Me.m_ses = New NotesSession
Set Me.m_db = Me.m_ses.CurrentDatabase
End Sub
Sub delete
End Sub
End Class
Thema: PDF's als Attachments - automatisch (Gelesen 3905 mal)