Domino 9 und frühere Versionen > ND6: Entwicklung

Mail + Attachment im Filesystem speichern

<< < (4/9) > >>

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"
...


--- Ende Code ---

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"

--- Ende Code ---

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

--- Ende Code ---


Axel

Navigation

[0] Themen-Index

[#] Nächste Seite

[*] Vorherige Sete