Mail + Attachment im Filesystem speichern

[gere]

Hallo Notes-Götter,

Ich habe ein sehr dringendes Problem, und zwar brauch ich ein Script, das es ermöglicht, Emails und deren Attachments (falls vorhanden) in einem fest definierten Ordner im FileSystem zu speichern. Der Email-Text soll dabei als Textfile gespeichert werden. Ich hab da schon ewig rumprobiert, nur leider hab ich nicht genug Erfahrung mit sowas.

Hat jemand so etwas auf Lager?

Danke + Gruß
Gere

[Axel]

Hi,

ich hab mal sowas ähnliches gebaut. Der Mailtext wird als Word-Dokument in einem, vom User frei wählbaren Verzeichnis gespeichert. Die Attachments werden ebenfalls in diesem Verzeichnis gespeichert und als Link ins Word-Dokument eingefügt.

Interessant für dich?


Axel

[gere]

Hi Axel,

Das wäre eigentlich genau das was ich suche...

Gruß Gerhard

[Axel]

Hi,

das Ganze habe ich in einen Agenten gepackt:

Code

(Options) - Section
Option Public
Use "libWord"
Use "FileLibrary"
 
Initialize - Section
Sub Initialize
	
	Dim workspace As New NotesUIWorkspace
	Dim uidoc As NotesUIDocument
	Dim doc As NotesDocument
	Dim rtitem As NotesRichTextItem
	Dim clsWord As cWord
	Dim intTitel As Integer
	Dim idx As Integer
	Dim intAbbruch As Integer
	Dim varName As Variant
	Dim varResult As Variant	
	Dim cFile As CFile
	Dim strMacro As String
	Dim strFileName As String
	Dim arrFiles() As String 
	
	Const ATTR_READONLY = 1
	
	intAbbruch = 0
	Redim arrFiles(0)
	
	On Error Goto ErrorHandling
	
	Set uidoc = workspace.CurrentDocument
	Set doc = uidoc.Document
	
	'Extrahieren des allgemeinen Namens aus dem Mail-Absender
	strMacro =  | @Name([CN]; DisplayFrom)|
	varName = Evaluate(strMacro, doc)
	'Messagebox varName(0) 
	
	'Wenn im allgm. Namen " enthalten sind, werden sie entfernt
	If Instr(varName(0), Chr$(34)) > 0 Then
		strMacro =   | @ReplaceSubstring(| & varName(0) & |; @Char(34); "")|
		varName = Evaluate(strMacro,doc)
		'Messagebox varName(0) 		
	End If  'If Instr(varName(0), Chr$(34)) > 0 Then
	
	'Austausch der : in . bei Uhrzeit
	strMacro =  | @ReplaceSubstring("| & doc.DisplayDate(0) & |"; ":"; ".")|
	varResult = Evaluate(strMacro)
	'Austausch des Leerzeichens in _ 
	strMacro =  | @ReplaceSubstring("| & varResult(0) & |"; " "; "_")|
	varResult = Evaluate(strMacro)
	
	'Abfrage des Verzeichnisses und des Dateinamens
	Set cFile = New cFile
	cFile.DefaultDir = ""
	cFile.DefaultFilename = varName(0) & " " & varResult(0) 'Vorgabedateiname ist der allg. Name des Senders und Empfangsdatum
	cFile.Title = "Mail-Export"
	cFile.Filter = "Word-Dokument (*.doc)" & Chr$(0) & "*.doc" & Chr$(0) & "Alle Dateien (*.*)" & Chr$(0) &  "*.*" & Chr$(0)
	cFile.FilterIndex = 1
	
	result = cFile.FileSaveDlg
	If result = 0 Then
		Messagebox "Der Export wurde abgegrochen.", 64, "Mail-Export"		
		Exit Sub
	End If 'If result = 0 Then
	
	While Dir$(cFile.Filename, 0) <> ""
		Messagebox "Der angegebene Dateiname ist bereits vorhanden." & Chr$(10) & "Bitte geben Sie einen anderen Dateinamen ein.", 48, "Mail-Export"
		result = cFile.FileSaveDlg
		If result = 0 Then
			Messagebox "Der Export wurde abgegrochen.", 64, "Mail-Export"		
			Exit Sub
		End If 'If result = 0 Then
	Wend  'While Dir$(cFile.Filename, 0) <> ""
	
	'Neue Instanz der Klasse cWord
	Set clsWord = New cWord
	'Neues Dokument auf Basis der Vorlage erstellen
	Call clsWord.CreateNewDoc("Normal")
	'Formatiertes Einfügen der Mail-Header Infos 
	Call clsWord.SetFontAttributes("Arial", 10, True, False, False)
	Call clsWord.Insert("Mail von:  ") 
	Call clsWord.SetFontAttributes("Arial", 10, False, False, False)       
	Call clsWord.Insert(doc.DisplayFrom(0))
	Call clsWord.Newline(1)
	Call clsWord.SetFontAttributes("Arial", 10, True, False, False)
	If Isdate(doc.DeliveredDate(0)) Then
		Call clsWord.Insert("Mail eingegangen am:  ") 
	Else
		Call clsWord.Insert("Mail gesendet am:  ") 
	End If  'If Isdate(doc.DeliveredDate(0)) Then
	Call clsWord.SetFontAttributes("Arial", 10, False, False, False)       
	Call clsWord.Insert(Cstr(doc.DisplayDate(0)))
	Call clsWord.Newline(2)
	Call clsWord.SetTab(2.5)
	
	Call clsWord.SetFontAttributes("Arial", 10, True, False, False)
	Call clsWord.Insert("An:  ")
	Call clsWord.SetFontAttributes("Arial", 10, False, False, False)  
	strMacro =  | @Name([Abbreviate]; SendTo)|
	varName = Evaluate(strMacro, doc)
	For idx = 0 To Ubound(varName)
		Call clsWord.Insert(Chr$(9) & varName(idx))
		Call clsWord.Newline(1)		
	Next  'For idx = 0 To Ubound(varName)
	
	Call clsWord.SetFontAttributes("Arial", 10, True, False, False)       	
	Call clsWord.Insert("Kopie:  ")
	Call clsWord.SetFontAttributes("Arial", 10, False, False, False)       	
	strMacro =  | @Name([Abbreviate]; CopyTo)|
	varName = Evaluate(strMacro, doc)
	For idx = 0 To Ubound(varName)
		Call clsWord.Insert(Chr$(9) & varName(idx))
		Call clsWord.Newline(1)		
	Next  'For idx = 0 To Ubound(varName)
	
	Call clsWord.SetFontAttributes("Arial", 10, True, False, False)       
	Call clsWord.Insert("Bindkopie:  ")
	Call clsWord.SetFontAttributes("Arial", 10, False, False, False) 
	strMacro =  | @Name([Abbreviate]; BlindCopyTo)|
	varName = Evaluate(strMacro, doc)
	For idx = 0 To Ubound(varName)
		Call clsWord.Insert(Chr$(9) & varName(idx))
		Call clsWord.Newline(1)		
	Next  'For idx = 0 To Ubound(varName)
	
	Call clsWord.Newline(2)
	
	Call clsWord.SetFontAttributes("Arial", 10, True, False, False)       
	Call clsWord.Insert("Thema:  ")
	Call clsWord.SetFontAttributes("Arial", 10, False, False, False)       
	Call clsWord.Insert(doc.Subject(0))
	Call clsWord.Newline(2)
	
	Call clsWord.ClearAllTabs
	
	'einfügen des Mailinhaltes als Text
	Set rtitem = doc.GetFirstItem( "Body" )
	If ( rtitem.Type = RICHTEXT ) Then
		Call clsWord.Insert(rtitem.GetFormattedText( False, 0 ))
	End If  'If ( rtitem.Type = RICHTEXT ) Then
	
	'Lösen der Anhänge ins gewählte Verzeichnis und einfügen eines Links in Dokument
	intTitel = 0
	idx = 0
	If ( rtitem.Type = RICHTEXT ) Then
		If xHasDocAttachments(doc) Then
			Forall o In rtitem.EmbeddedObjects
				If ( o.Type = EMBED_ATTACHMENT ) Then
					strFileName = Cstr(cFile.ExtractFilePath(cFile.Filename)) & o.Name
					While Dir$(strFileName, 0) <> "" And intAbbruch <> 1
						varResult = workspace.Prompt( PROMPT_OKCANCELEDIT, "Mail-Export", "Eine Datei mit diesem Namen ist bereits vorhanden." & Chr$(10) &_
						"Bitte vergeben Sie einen anderen Namen", strFileName, "")
						If Isempty(varResult) Then
							intAbbruch = 1
						Else
							strFileName = Cstr(varResult)
						End If  'If Isempty(varResult) Then
					Wend  'Do While Dir$(strFileName, 0) <> ""
					If intAbbruch Then Exit Forall
					
					If intTitel = 0 Then
						Call clsWord.Newline(2)
						Call clsWord.Insert("Es sind folgende Dateianhänge vorhanden:")
						Call clsWord.Newline(1)
						intTitel = 1
					End If  'If intTitel = 0 Then
					Redim Preserve arrFiles(idx)
					arrFiles(idx) = strFileName
					idx = idx + 1
					Call clsWord.InsertLink(strFileName, Cstr(cFile.ExtractFileName(strFileName)))
					Call clsWord.Newline(1)
					'Dateianhang lösen
					Call o.ExtractFile (strFileName)
					Setfileattr strFileName , ATTR_READONLY
				End If
			End Forall			
		End If  'If xHasDocAttachments(doc) Then
	End If  'If ( rtitem.Type = RICHTEXT ) Then
	
	If intAbbruch Then
		'Export abgebrochen
		'Word wird ohne zu speichern beendet
		Call clsWord.CloseWord	
		Delete clsWord
		'Alle bisher gelösten Dateien werden gelöscht
		For idx = 0 To Ubound(arrFiles)
			If arrFiles(idx) <> "" Then
				Setfileattr arrFiles(idx) , ATTR_NORMAL				
				Kill arrFiles(idx)
			End If  'If arrFiles(idx) <> "" Then
		Next  'For idx = 0 To Ubound(arrFiles)
		Messagebox "Der Export wurde abgegrochen.", 64, "Mail-Export"
	Else
		'Worddokument wird gespeichert und Word wird beendet
		Call clsWord.SaveDoc(Cstr(cFile.Filename))
		Call clsWord.CloseWord	
		Delete clsWord
		
		'Setzen des Schreibschutzes auf Word-DAtei
		Setfileattr Cstr(cFile.Filename), ATTR_READONLY
		
		Messagebox "Das Mail wurde erfolgreich exportiert.", 64, "Mail-Export"		
	End If  'If intAbbruch Then
	
	Exit Sub
	
ErrorHandling:
	Messagebox "Das Mail konnte nicht exportiert werden." + Chr$(13) + "Fehler: " + Str$(Err) + " -> '" + Error$ + _
	"' in Zeile " + Str$(Erl) , 16, "Mail-Export"
	
	'Aufräumen
	If Not (clsWord Is Nothing) Then
		Call clsWord.CloseWord
		Delete clsWord
	End If  'If Not (clsWord Is Nothing) Then
	
	Exit Sub         
	
End Sub
 
 
Function xHasDocAttachments(doc As NotesDocument) As Integer
	
	Dim vEval As Variant
	vEval = Evaluate("@Attachments", doc)
	If vEval(0) = 0 Then 
		xHasDocAttachments = False
	Else
		xHasDocAttachments = True
	End If
	
End Function

Den Code der benötigten Script-Lib habe ich angehängt. Den Agent starte ich über einen Aktions-Button in der Memo- und den beiden Antwortmasken.


Axel

[gere]

Super, vielen herzlichen Dank!!!
Werd ich gleich testen.

Gruß Gere

[shiraz]

Hi Axel,

es funzt einwandfrei!!

 

[gere]

Hallo Axel,

Super, das Script rennt total gut! Ich hab im Agent noch eingebaut, dass für jede abgelegte Email ein eigenes Verzeichnis mit Datum/Uhrzeit im FileSystem angelegt wird.
Vielen Dank nochmal, Du hast mich enorm weitergebracht!

Gruß Gere

[(h)uMan]

Hallo,

ich bräuchte eine Lösung, um nur vorhandene Attachments von Dokumenten (Auswahl über Ansichten oder Ordner im Notes Client) im Filesystem mit analoger Ordnerstruktur wie in der MailDB zu speichern.

Bin kein Entwickler, daher auf Hilfe angewiesen ...

SG, Neo

[gere]

Hallo,

Ich hätte einen Agenten, der es ermöglicht, Dateien aus einer Datenbank ins File System zu lösen. Dabei werden Ordner erstellt, die nach dem Erstelldatum der jeweiligen Datei benannt werden. Aber das könntest Du relativ einfach anpassen, auch wenn Du kein Entwickler bist. Bist Du daran interessiert?

Gruß Gere

[(h)uMan]

Hallo,

bin noch in der Sandbox fündig geworden und werde den Agenten erstmal testen.

http://www-10.lotus.com/ldd/sandbox.nsf/ecc552f1ab6e46e4852568a90055c4cd/fe7542cd3b120e1b00256c38004a6a27?OpenDocument&Highlight=0,detach

Vielen Dank für die Infos.

SG, Neo

[Rachimow]

Hallo ich kann leider die Datei nicht herrunterladen.

Bin für jeden Tip dankbar

hydae

[koehlerbv]

Um welche Datei geht es denn? Und warum ist "Rachimow" bereits wieder abgemeldet?
Was soll das?

[NotesForum]

Hatte 2 Zugange deswegen habe ich den einen gelöscht.

Problem hat sich erledigt.

Rachimow

[koehlerbv]

Erstaunlich. Rachimow angemeldet und unterschreibt mit "hydae". Hydrae angemeldet und unterschreibt mit Rachimow.

Eine "vertrauensbildende Massnahme" ist das nicht gerade ...

Bernhard Köhler

[LDCOE]

Hallo,
bin leider kein Entwickler und habe Probleme mit den LSS Dateien. Wo muss ich diese einfügen? Unter Declarations mit Datei-> importieren?   
Vielen Dank vorab für eure Mühe!

Gruss Jens

[Axel]

Nimm den Code aus den LSS-Dateien und füge in jeweils in eine neue Script-Bibliothek ein. Benenne die Bibliothek dann so wie die LSS-Datei heißt.


Axel

[LDCOE]

Hallo, herzlichen Dank für die Antwort,
ich habe die Script-Bibliotheken angelegt wie beschreiben. Nach den Bibs habe ich den Agenten neu erstellt.
Es scheint wohl ein Problem mit der Klasse Cfile zu geben, in der Zeile:
"Dim cFile As CFile"   kommt die Meldung "Class or File Name not found".
Hast du einen Tipp woher dieser Fehler kommen könnte?


Gruss Jens 

[Axel]

Hast du die Bibliotheken auch mit Use ... in den Agenten eingebunden.

Code

 
(Options) - Section
Option Public
Use "libWord"
Use "FileLibrary"
...
 

Axel

[LDCOE]

Hallo,
ja das habe ich, den oberen Teil habe ich bei Options, den Rest bei Initialize einkopiert. Der Options Teil Sieht folgendermassen aus:

Option Public
Use "libWord"
Use "FileLibrary"

Die Script-Lib habe ich über Importieren jeweils in eine neue Bib kopiert und entsprechende Namen vergeben.
Hab ich noch was vergessen?

Gruss Jens

[Axel]

Unter Umständen ist beim Importieren des Codes was schiefgegangen und das Ganze steht nicht in den richtigen Abschnitten,

Deine Lib FileLibrary müsste so aussehen

Abschnitt (Options)

Code

Option Public
%INCLUDE "LSCONST.LSS"

Abschnitt (Declarations)

Code

'Struktur für Dateidialoge definieren
Type fileDlgStruct
	lStructSize As Long     
	hwndOwner As Long     
	hInstance As Long     
	lpstrFilter As String     
	lpstrCustomFilter As Long     
	nMaxCustFilter As Long     
	nFilterIndex As Long     
	lpstrFile As String     
	nMaxFile As Long     
	lpstrFileTitle As String     
	nMaxFileTitle As Long     
	lpstrInitialDir As String     
	lpstrTitle As String     
	Flags As Long     
	nFileOffset As Integer     
	nFileExtension As Integer     
	lpstrDefExt As String     
	lCustData As Long     
	lpfnHook As Long     
	lpTemplateName As Long          
End Type
 
'Funktionen aus DLL
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (fileDlg As fileDlgStruct)  As Long
Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (fileDlg As fileDlgStruct)  As Long
 
'Konstanten für Dateidialog festlegen
Const OFN_ALLOWMULTISELECT = &H200
Const OFN_CREATEPROMPT = &H2000
Const OFN_ENABLEHOOK = &H20
Const OFN_ENABLETEMPLATE = &H40
Const OFN_ENABLETEMPLATEHANDLE = &H80
Const OFN_EXPLORER = &H80000                      
Const OFN_EXTENSIONDIFFERENT = &H400
Const OFN_FILEMUSTEXIST = &H1000
Const OFN_HIDEREADONLY = &H4
Const OFN_LONGNAMES = &H200000             
Const OFN_NOCHANGEDIR = &H8
Const OFN_NODEREFERENCELINKS = &H100000
Const OFN_NOLONGNAMES = &H40000  
Const OFN_NONETWORKBUTTON = &H20000
Const OFN_NOREADONLYRETURN = &H8000
Const OFN_NOTESTFILECREATE = &H10000
Const OFN_NOVALIDATE = &H100
Const OFN_OVERWRITEPROMPT = &H2
Const OFN_PATHMUSTEXIST = &H800
Const OFN_READONLY = &H1
Const OFN_SHAREAWARE = &H4000
Const OFN_SHAREFALLTHROUGH = 2
Const OFN_SHARENOWARN = 1
Const OFN_SHAREWARN = 0
Const OFN_SHOWHELP = &H10
 
'Klasse cFiel
Class cFile
	
	'öffentliche Eigenschaften der Klasse
	Public DefaultDir As String  'Vorgabeverzeichnis
	Public DefaultFilename As String  'Vorgabedateiname
	Public FileName As String  'gewählter Dateiname incl. Verzeichnis
	Public FileTitle As String  'gewählter Dateiname
	Public Filter As String  'Liste für Filter
	Public FilterIndex As Integer  'Index für Vorgabefilter
	Public Title As String	'Titel der Dialogbox
	
	'private Klasseneigenschaften
	myfileDlg As fileDlgStruct
	
	'Methode für Datei-Öffnen Dialog
	Function FileOpenDlg () As Integer
		
		Dim APIResults As Integer
		Dim szFileName As String *255
		Dim szFileTitle As String *255
		Dim szCurrentDir As String *255
		Dim Index As Integer
		
          'Speicher für Rückgabestrings allokieren
		szFileName = Chr$(0) & Space$(255) & Chr$(0)
		szFileTitle = Space$(255) & Chr$(0)
		
          'Vorgabe - Extension initialisieren.     
		DefExt = Chr$(0)
		
          'Vorgabewerte setzen
		szCurrentDir = DefaultDir & Chr$(0)
		szFileName = DefaultFileName & Chr$(0)
		Title = Title & Chr$(0)
		
          'FilterIndex prüfen
		If FilterIndex <= 0 Then FilterIndex = 1
		
         'Initialisierung der Datenstruktur
		myFileDlg.lStructSize = Len(myFileDlg)
		
		myFileDlg.hwndOwner = 0&  'If the OpenFile Dialog box is not linked to any form use this line.It will pass a null pointer.
		myFileDlg.lpstrFilter =  Filter     
		myFileDlg.nFilterIndex = FilterIndex
		myFileDlg.lpstrFile = szFileName     
		myFileDlg.nMaxFile = Len(szFileName)     
		myFileDlg.lpstrFileTitle = szFileTitle     
		myFileDlg.nMaxFileTitle = Len(szFileTitle)     
		myFileDlg.lpstrTitle = Title     
		myFileDlg.Flags = OFN_LONGNAMES + OFN_HIDEREADONLY + OFN_PATHMUSTEXIST
		myFileDlg.lpstrDefExt = DefExt     
		myFileDlg.hInstance = 0     
		myFileDlg.lpstrCustomFilter = 0     
		myFileDlg.nMaxCustFilter = 0     
		myFileDlg.lpstrInitialDir = szCurrentDir     
		myFileDlg.nFileOffset = 0     
		myFileDlg.nFileExtension = 0     
		myFileDlg.lCustData = 0     
		myFileDlg.lpfnHook = 0     
		myFileDlg.lpTemplateName = 0     
		
		'Anzeigen des Dialoges
		APIResults = GetOpenFileName(myFileDlg)
		
		'Bearbeiten der Rückgabewerte
		If APIResults <> 0 Then                    
			szFileName = Cstr( myFileDlg.lpstrFile )          
			szFileTitle = Cstr( myFileDlg.lpstrFileTitle )
			FileName = Left$(szFileName, Instr(szFileName, Chr$(0)))
			FileTitle = Left$(szFileTitle, Instr(szFileTitle, Chr$(0)))
			FileOpenDlg = 1          
		Else           
			FileOpenDlg = 0
		End If  'If APIResults <> 0 Then                    
		
	End Function 'Function FileOpenDlg () As Integer
	
	
	'Methode für Datei-Speichern Dialog
	Function FileSaveDlg()
		
		Dim APIResults As Integer
		Dim szFileName As String *255
		Dim szFileTitle As String *255
		Dim szCurrentDir As String *255
		
          'Speicher für Rückgabestrings allokieren
		FileName = Chr$(0) & Space$(255) & Chr$(0)
		szFileTitle = Space$(255) & Chr$(0)
		
         'Vorgabe - Extension initialisieren.     
		DefExt = Chr$(0)
		
          'Setzen der Vorgabewerte
		szCurrentDir = DefaultDir  & Chr$(0)
		szFileName = DefaultFileName & Chr$(0)
		Title = Title & Chr$(0)
		
          'FilterIndex prüfen
		If FilterIndex <= 0 Then FilterIndex = 1
		
         'Initialisierung der Datenstruktur
		myFileDlg.lStructSize = Len(myFileDlg)
		
		myFileDlg.hwndOwner = 0&  'If the OpenFile Dialog box is not linked to any form use this line.It will pass a null pointer.
		myFileDlg.lpstrFilter =  Filter     
		myFileDlg.nFilterIndex = FilterIndex     
		myFileDlg.lpstrFile = szFileName     
		myFileDlg.nMaxFile = Len(szFileName)     
		myFileDlg.lpstrFileTitle = szFileTitle     
		myFileDlg.nMaxFileTitle = Len(szFileTitle)     
		myFileDlg.lpstrTitle = Title     
		myFileDlg.Flags = OFN_FILEMUSTEXIST + OFN_LONGNAMES + OFN_HIDEREADONLY + OFN_PATHMUSTEXIST
		myFileDlg.lpstrDefExt = DefExt     
		myFileDlg.hInstance = 0     
		myFileDlg.lpstrCustomFilter = 0     
		myFileDlg.nMaxCustFilter = 0     
		myFileDlg.lpstrInitialDir = szCurrentDir     
		myFileDlg.nFileOffset = 0     
		myFileDlg.nFileExtension = 0     
		myFileDlg.lCustData = 0     
		myFileDlg.lpfnHook = 0     
		myFileDlg.lpTemplateName = 0     
		
		'Anzeigen des Dialoges
		APIResults = GetSaveFileName(myFileDlg)
		
		'Bearbeiten der Rückgabewerte
		If APIResults <> 0 Then                    
			szFileName = Cstr( myFileDlg.lpstrFile )          
			szFileTitle = Cstr( myFileDlg.lpstrFileTitle )
			FileName = Left$(szFileName, Instr(szFileName, Chr$(0)))
			FileTitle = Left$(szFileTitle, Instr(szFileTitle, Chr$(0)))
			FileSaveDlg = 1          
		Else           
			FileSaveDlg = 0
		End If  'If APIResults <> 0 Then                    
		
	End Function  'Function FileSaveDlg()
	
	
	'Methode zum Prüfen ob ein Verzeichnis vorhanden ist
	Function IsValidDir(sPath As String) As Integer
		
		On Error Resume Next
		
		attr% = Getfileattr(sPath)
		If Err > 0 Then
			IsValidDir = 0
			Exit Function
		End If  'If Err > 0 Then
		If (attr% And ATTR_DIRECTORY) Then IsValidDir = 1
		
	End Function  'Function IsValidDir(sPath As String) As Integer
	
	
	'Methode zum Anlegen von Verzeichnissen
	Function MakeDir (sPath As String) As Integer
		
		Dim sNewPath As String
		Dim iPosi As Integer
		
		If Right$(sPath,1) <> "\" Then sPath = sPath & "\"
		MakeDir = 1
		
		On Error Goto MakeDirError
		
		Do
			iPosi = Instr(iPosi + 1, sPath, "\")
			If iPosi > 0 Then
				sNewPath = Left$(sPath, iPosi - 1)
				If Me.IsValidDir(sNewPath) = 1 Then
					Mkdir sNewPath
				End If  'IsValidDir(sNewPath) = 0...
			End If  'iPosi > 0...
		Loop Until iPosi = 0
		
		MakeDir = 0
		
Ende:		
		Exit Function
		
MakeDirError:
		Messagebox "Error " & Str(Err) & " : " & Error$ 
		Resume Ende
		
	End Function 'Function MakeDir (sPath As String) As Integer
	
	
	'Methode zum Kopieren von einer Datei
	'source -> Quelldatei incl. Verzeichnis
	'destination -> Zielverzeichnis ohne Dateinamen
	Function CopyFile(source As String, destination As String) As Integer
		
		On Error Goto Errorhandler
		
		If source = "" Then
			Messagebox "Sie haben keine Quelldatei zum Kopieren angegeben." , MB_ICONEXCLAMATION, "Datei kopieren"
			CopyFile = 1
			Exit Function               
		End If  'If source = ""
		
		If destination = "" Then
			Messagebox "Sie haben keine Ziel zum Kopieren angegeben." , MB_ICONEXCLAMATION, "Datei kopieren"
			CopyFile = 1
			Exit Function               
		End If  'If destination = ""
		
		If Strcompare(source, destination, 5) = 0 Then
			Messagebox "Quelle und Ziel dürfen nicht gleich sein." , MB_ICONEXCLAMATION, "Datei kopieren"
			CopyFile = 1
			Exit Function               
		End If  'If StrCompare...          
		
		If Dir$(source, 0) = "" Then
			Messagebox "Datei " & source & " ist nicht vorhanden" , MB_ICONEXCLAMATION, "Datei kopieren"
			CopyFile = 1
			Exit Function
		End If  'If Dir$(source, 0) = ""
		
		If Dir$( destination , 16) = "" Then 
			If Messagebox ("Verzeichnis " & destination & " ist nicht vorhanden" & Chr$(13) & Chr$(10) &"Möchten Sie das Verzeichnis erstellen?",_
			MB_YESNO + MB_ICONQUESTION, "Datei kopieren" ) = IDYes Then
				If Me.MakeDir(destination) = 1 Then
					Messagebox "Verzeichnis " & destination & " konnte nicht angelegt werden" , MB_ICONEXCLAMATION, "Datei kopieren"
					CopyFile = 1
					Exit Function
				End If   'If Me.MakeDir(destination) = 1 Then                   
			Else
				CopyFile = 1
				Exit Function               
			End If  'If Messagebox ("Verzeichnis " & destination & " ist 
		End If  'If Dir$(destination, 16) = ""
		
		If Right$(destination,1) <> "\" Then destination = destination & "\"
		destination = destination & Me.ExtractFileName(source)
		
		If Dir$(destination, 0) = destination Then
			If Messagebox ("Datei " & destination & " ist bereits vorhanden." & Chr$(13) & Chr$(10) &"Möchten Sie die Datei überschreiben?", _
			MB_YESNO + MB_ICONQUESTION, "Datei kopieren" ) = IDYes Then
				Filecopy source, destination
				Messagebox "Datei " & destination & " wurde erfolgreich kopiert", MB_ICONINFORMATION, "Datei kopieren"
				CopyFile = 0
			End If  'If Messagebox ("Datei existiert bereits. Überschreiben",  ...
		Else
			Filecopy source, destination
			Messagebox "Datei " & destination & " wurde erfolgreich kopiert", MB_ICONINFORMATION, "Datei kopieren"                   
			CopyFile = 0
		End If  'If Dir$(destination...  
		
Ende:     
		Exit Function
		
ErrorHandler:
		If Err = 76 Then
			Resume Next
		Else
			Messagebox "Beim Kopieren ist ein Fehler aufgetreten." & Chr$(13) & Chr$(10) & "Fehlernr.: " & Str$(Err) & " -> " & Error$, _
			MB_ICONSTOP, "Datei kopieren"
			CopyFile = 1
			Resume Ende          
		End If  'If Err = 76 Then
		
	End Function  'Function CopyFile(source As String, destination As String) As Integer	
	
	
	'Methode zum extrahieren des Dateinamens
	Function ExtractFileName( sPath As String) As String
		
		Dim iPos As Integer
		Dim iPosSave As Integer
		
		Do
			iPosi = Instr(iPosi + 1, sPath, "\")
			If iPosi > 0 Then iPosSave = iPosi + 1
		Loop Until iPosi = 0
		ExtractFileName = Mid$(sPath,iPosSave)
		
	End Function  'Function ExtractFileName( sPath As String) As String
	
	
	'Methode zum Extrahieren des Verzeichnisteils
	Function ExtractFilePath(sPath As String) As String
		
		Dim iPos As Integer
		Dim iPosSave As Integer
		
		Do
			iPosi = Instr(iPosi + 1, sPath, "\")
			If iPosi > 0 Then iPosSave = iPosi
		Loop Until iPosi = 0
		ExtractFilePath = Left$(sPath,iPosSave)
		
	End Function  'Function ExtractFilePath(sPath As String) As String
	
End Class  'Class cFile

Axel