| Sub Click(Source As Button) |
| On Error Goto errHandler |
| Dim uiws As New NotesUIWorkspace |
| Dim uidoc As NotesUIDocument |
| Dim session As New NotesSession |
| Dim db As NotesDatabase |
| Dim doc As NotesDocument |
| Dim vFilepath As Variant |
| Dim vFileLength As Long |
| Dim strFilepath As String |
| Dim strEndung As String |
| |
| Set db = session.CurrentDatabase |
| Set uidoc = uiws.CurrentDocument |
| Set doc = uidoc.Document |
| |
| Call uidoc.FieldSetText ( "Signatur", "") 'Feld löschen |
| Call uidoc.GotoField("Signatur") 'zum Feld springen |
| |
| vFilepath = uiws.OpenFileDialog( True, db.Title, "All supported Images|*.jpg;*.jpeg;*.cgm;*.bmp;*.gif;*.pcx|GIF-Image|*.gif|JPEG-Image|*.jpg;*.jpeg|BMP-Image|*.bmp|CGM-Image|*.cgm", "c:\") |
| |
| If Isempty(vFilepath) Then Exit Sub ' Script verlassen falls User keine Datei auswählt |
| |
| Forall ImageList In vFilepath ' Durch die ausgewählten Dateien loopen |
| |
| strFilepath = ImageList |
| vFileLength = Filelen(strFilepath) 'Dateigröße auslesen |
| If vFileLength > 300000 Then Goto picerrHandler 'Dateigröße checken |
| |
| 'Hole die Dateiendung in den String, dabei mit LowerCase auf Kleinschreibung umgestellt |
| strEndung = Lcase$(Right$(strFilepath, 3)) |
| |
| Select Case strEndung |
| Case "gif": |
| Call uidoc.Import("GIF Image",strFilepath) |
| Case "jpg": |
| Call uidoc.Import("JPEG Image",strFilepath) |
| Case "cgm": |
| Call uidoc.Import("CGM Image",strFilepath) |
| Case "peg": |
| Call uidoc.Import("JPEG Image",strFilepath) |
| Case "pcx": |
| Call uidoc.Import("PCX Image",strFilepath) |
| Case "bmp": |
| Call uidoc.Import("BMP Image",strFilepath) |
| End Select |
| |
| End Forall |
| |
| exitScript: |
| Exit Sub |
| |
| picerrHandler: |
| Msgbox "Es ist ein Fehler aufgetreten." & Chr(10) & Chr(10) _ |
| & "Das ausgewählte Bild ist zu groß." |
| Goto exitScript |
| |
| errHandler: |
| Msgbox "Es ist ein Fehler aufgetreten." & Chr(10) & Chr(10) _ |
| & "Fehlermeldung: " & Error$ & Chr(10) _ |
| & "Fehlernummer: " & Err & Chr(10) _ |
| & "Codezeile: " & Erl & Chr(10) _ |
| ,64,"Error" |
| Resume exitScript |
| End Sub |