commands.add "OUTLOOKIMPORT","importieren von Outlook-Emails ","ImportOutlookEmails","bmpAKT"


 Sub ImportOutlookEmails() 

    'Importiert Emails aus dem Outlook - Standardordner Posteingang als Aktivität 
    'Legt Anhänge je nach Dateityp als Attachements oder Archiv-DS an 

    Dim I 		'As Integer 
    Dim F 		'As Integer 
    Dim iSeitenZaehler 	'As Integer 
    Dim lBlobTyp 	'As Long 
    Dim oUtil 		'As cUtil 
    Dim strBenMKMDSN 	'As String 
    Dim strLinkAD_DSN 	'As String 
    Dim strTempPath 	'As String 

    
    Dim otlkApp 	'As Outlook.Application 
    Dim otlFolder 	'As Outlook.MAPIFolder 
    Dim otlMail 	'As Outlook.MailItem 
    Dim otlAttachm 	'As Outlook.Attachment 

    Dim rsAktivitaet 		'As Recordset   'ein RS zum anlegen von Aktivität
    Dim rsSearchAktivitaet 'As Recordset   'ein RS zum suchen von Aktivität
    Dim rsTapi 		'As Recordset
    Dim rsArchiv 	'As Recordset
    Dim rsAktivArt 	'As Recordset
    Dim rsAktMkm 	'As Recordset

    Set otlkApp = GetObject("", "Outlook.Application")  'Startet evtl. Outlook
 
    Set otlFolder = otlkApp.GetNamespace("MAPI").GetDefaultFolder(6)    ' olFolderInbox hier StandardOrdner Posteingang

    Set oUtil = Application.Util
    
    strBenMKMDSN = Application.CurrentUserRS("STD_MKM1")

	msgbox "Importiere Emails aus Outlook"

    Set rsAktivArt = Application.GetRecordset(" Select * from aktivitätenarten where Name = 'E allg. e-mail'")

    If rsAktivArt.AbsolutePosition = -1 Then
        If (oUtil.msgask("Die Aktivitätenart 'E allg. e-mail' wurde nicht gefunden.Soll die Aktivitätenart '(Neutral)' verwendert werden?", True)) Then
            Set rsAktivArt = Application.GetRecordset(" Select * from aktivitätenarten where Name = '(Neutral)'")
            If rsAktivArt.AbsolutePosition = adPosUnknown Then Exit Sub
        Else
            Exit Sub
        End If
    End If

    'leeres Aktivitäten-Recordset zum Anlegen der DS erstellen
    Set rsAktivitaet = Application.GetRecordset("Select * from AKT where 1=2 ")

    'leeres Aktivitäten-Merkmale-Recordset zum Anlegen erstellen
    Set rsAktMkm = Application.GetRecordset("Select * from AKTMKM where 1=2 ")

    For I = 1 To otlFolder.Items.Count     'hier mit Folder.Items beginnt bei Outlook mit 1 !!

        Set otlMail = otlFolder.Items.Item(I)

        'Suchen ob schon vorhanden -> da die EntryID in Stichwort1 eingetragen wird, 
        'ist dies das eindeutige Kennzeichen für eine bereits importierte Email - aber Achtung : durch die Sicherheitsbeschränkungen werden
	'nur die durchsucht, für die auch Leseberechtigung besteht
        Set rsSearchAktivitaet = Application.GetRecordset("Select DSN, Stichwort1 from AKT where STICHWORT1 = '" & otlMail.EntryID & "'")

        If rsSearchAktivitaet.AbsolutePosition = -1 Then   'adPosUnknown

	msgbox "Importiere Email: " &  otlMail.subject 

            'Adresse suchen
            Set rsTapi = Application.GetRecordset("Select * from TAPI WHERE Nummer = '" & otlMail.SenderName & "'")

            If rsTapi.AbsolutePosition = -1 Then
                strLinkAD_DSN = Application.CurrentUserRS("AD_DSN")
            Else
                strLinkAD_DSN = rsTapi("AD_DSN")
            End If

            '1. AKT_DS hinzufügen
            rsAktivitaet.AddNew
            rsAktivitaet("DSN") = oUtil.NewGUID
            rsAktivitaet("AD_DSN") = strLinkAD_DSN
            rsAktivitaet("ART_DSN") = rsAktivArt("DSN")
            rsAktivitaet("PRIORITÄT") = 1
            rsAktivitaet("DATUM") = otlMail.CreationTime
            rsAktivitaet("DATUM_BIS") = otlMail.CreationTime
            rsAktivitaet("VORLAGE") = DateAdd("d", ((rsAktivArt("VORLAGE").Value)), Now)
            rsAktivitaet("STICHWORT1") = otlMail.EntryID
            rsAktivitaet("NOTIZ") = otlMail.Subject & vbCrLf & vbCrLf & otlMail.Body & vbCrLf & String(50, "_") & vbCrLf _
                    & "Diese Email von " & otlMail.SenderName & " an " & otlMail.To & " wurde aus Outlook importiert!" & vbCrLf


            '2. Anlegen der Merkmale zur Aktivität
            rsAktMkm.AddNew
            rsAktMkm("MKM_DSN") = strBenMKMDSN
            rsAktMkm("LINK_DSN") = rsAktivitaet("DSN")

	    iSeitenZaehler = 0

            'evtl. Anhänge ebenfalls ablegen
            If otlMail.Attachments.Count > 0 Then
			
               For F = 1 To otlMail.Attachments.Count

                    'Attachment als Datei extrahieren
                    Set otlAttachm = otlMail.Attachments.Item(F)
                    
                    'nicht jeden typ importieren
                    If otlAttachm.Type = 1    Then  'olByValue
                    
                        strTempPath = (oUtil.GetTempPath & otlAttachm.FileName)
                        otlAttachm.SaveAsFile strTempPath

                        If  UCase(oUtil.GetFileExtender(otlAttachm.FileName))= "TIF" Then

                        
                            ' für Tif einen Archivdatensatz anlegen
                            Set rsArchiv = Application.GetRecordset("Select * from ARCHIV WHERE 1=2")

                            lBlobTyp = 3   ' Archiv

                            rsArchiv.AddNew
                            rsArchiv("DSN") = oUtil.NewGUID
                            rsArchiv("AKT_DSN") = rsAktivitaet("DSN")
                            rsArchiv("SEITE") = CSTR(iSeitenZaehler + 1)
                            rsArchiv("BEZEICHNUNG") = "Anhang aus Outlook-Email"

                            iSeitenZaehler = iSeitenZaehler + 1

                            Application.UpdateRecordset (rsArchiv)
                            Application.Blob.SaveblobFile strTempPath, rsArchiv("DSN"), lBlobTyp

                            rsAktivitaet("NOTIZ") = rsAktivitaet("NOTIZ") & vbCrLf & "Datei:" & otlAttachm.FileName & " wurde als Archiv-Datensatz hinzugefügt!"

                        Else 

                            lBlobTyp = 6   ' Attachment
                            Application.Blob.SaveblobFile strTempPath, rsAktivitaet("DSN"), lBlobTyp   ' ohne GUID -> Neu Anlage

                            rsAktivitaet("NOTIZ") = rsAktivitaet("NOTIZ") & vbCrLf & "Datei:" & otlAttachm.FileName & " wurde als Anhang hinzugefügt!"

                        End If
                        
                    End If
                    
                Next 'nächste Attachment

            End If
            
            Application.UpdateRecordset (rsAktivitaet)
            Application.UpdateRecordset (rsAktMkm)

        End If   ' Kein Else-Zweig, da diese Email dann schon importiert wurde!

    Next    'Nächste Email
    
    Msgbox "Fertig!"

End Sub