Holzkopf80
Grünschnabel
Hallo?!
Mein Problem besteht darin, das ich mit folgendem Programmcode meine emails in Outlook speichern kann.
Aber ich möchte nur eine Markierte email speichern. Diese soll auch noch einer PersonenId zugewiesen werden.
Kann mir jemand in diesem Forum weiterhelfen?
Sub EingangsMailsAusOutlookÜbernehmen()
On Error Goto EingangsMailsAusOutlookÜbernehmen_Err
Dim OutlN As New Outlook.Application
Dim Eingangsbox As Object
Dim objKon As Object
Dim DBS As Recordset
Dim Conn As Database
Dim IntMailZ As Integer
Set Conn = CurrentDb
Set DBS = Conn.OpenRecordset("EingangMails", dbOpenDynaset)
IntMailZ = 0
Set Eingangsbox = OutlN.GetNamespace ("MAPI").GetDefaultFolder (olFolderInbox)
For IntMailZ = 1 To Eingangsbox.Items.Count
Set objKon = Eingangsbox.Items(IntMailZ)
With objKon
DBS.AddNew
DBS!Titel = .Subject
DBS!Empfänger = .To
DBS!Mailer = .SenderName
DBS!Datum = .CreationTime
'oder:
'DBS!Datum = Format(.ReceivedTime, "DD.MM.YYYY hh:mm")
DBS!Größe = .Size
DBS!Inhalt = .Body
End With
DBS.Update
Next IntMailZ
MsgBox "Datentransfer erfolgreich beendet! " & vbLf & _
"Es wurden " & IntMailZ & " Sätze angelegt!", vbInformation
EingangsMailsAusOutlookÜbernehmen_Exit:
DBS.Close
Set objKon = Nothing
Set OutlN = Nothing
Exit Sub
EingangsMailsAusOutlookÜbernehmen_Err:
MsgBox "Es ist ein Fehler aufgetreten!"
Goto EingangsMailsAusOutlookÜbernehmen_Exit
End Sub
Mit dieser Lösung funktioniert es, nur möchte ich einzelne Emails anklicken und speichern. nicht alle mails!
Hab ich vieleicht das Problem falsch angegangen?
Mein Problem besteht darin, das ich mit folgendem Programmcode meine emails in Outlook speichern kann.
Aber ich möchte nur eine Markierte email speichern. Diese soll auch noch einer PersonenId zugewiesen werden.
Kann mir jemand in diesem Forum weiterhelfen?
Sub EingangsMailsAusOutlookÜbernehmen()
On Error Goto EingangsMailsAusOutlookÜbernehmen_Err
Dim OutlN As New Outlook.Application
Dim Eingangsbox As Object
Dim objKon As Object
Dim DBS As Recordset
Dim Conn As Database
Dim IntMailZ As Integer
Set Conn = CurrentDb
Set DBS = Conn.OpenRecordset("EingangMails", dbOpenDynaset)
IntMailZ = 0
Set Eingangsbox = OutlN.GetNamespace ("MAPI").GetDefaultFolder (olFolderInbox)
For IntMailZ = 1 To Eingangsbox.Items.Count
Set objKon = Eingangsbox.Items(IntMailZ)
With objKon
DBS.AddNew
DBS!Titel = .Subject
DBS!Empfänger = .To
DBS!Mailer = .SenderName
DBS!Datum = .CreationTime
'oder:
'DBS!Datum = Format(.ReceivedTime, "DD.MM.YYYY hh:mm")
DBS!Größe = .Size
DBS!Inhalt = .Body
End With
DBS.Update
Next IntMailZ
MsgBox "Datentransfer erfolgreich beendet! " & vbLf & _
"Es wurden " & IntMailZ & " Sätze angelegt!", vbInformation
EingangsMailsAusOutlookÜbernehmen_Exit:
DBS.Close
Set objKon = Nothing
Set OutlN = Nothing
Exit Sub
EingangsMailsAusOutlookÜbernehmen_Err:
MsgBox "Es ist ein Fehler aufgetreten!"
Goto EingangsMailsAusOutlookÜbernehmen_Exit
End Sub
Mit dieser Lösung funktioniert es, nur möchte ich einzelne Emails anklicken und speichern. nicht alle mails!
Hab ich vieleicht das Problem falsch angegangen?