andere Postfächer in Outlook per VBA abrufe

Home-›Foren-›Outlook-›andere Postfächer in Outlook per VBA abrufe

2 Antworten anzeigen - 1 bis 2 (von insgesamt 2)
  • Autor
    Beitrag
  • #49617
    Unbekannt
    Teilnehmer

      Hallo zusammen,

      ich verwende das folgende Listing um E-Mails aus meinem Posteingang zu importieren, Anlagen in einem vorgegebenen Verzeichnis abzulegen und den Betreff der erfassten E-Mail mit einem automatisierten Eintrag zu ergänzen.

      Nun will ich diese auch in der Firma nutzen. Allerdings gibt es in der Firma mehrere Postfächer die im Netzwerk angezeigt werden und aus denen dann Mails importiert werden sollen. Beispiel das Postfach \”Abteilung III\” oder das Postfach eines Kollegen \”Nachname Vorname -Abt.III\”.
      Ich habe alles mögliche versucht allerdings greift mein Programm stets nur auf mein persönliches Postfach zu.
      Wie kann ich ein anderes Postfach hier zugänglich machen?
      Wäre prima, wenn ihr das an den o.g. Beispielen erklären könntet.

      Vorab vielen Dank.
      Gruß
      Florian-BGL
      [code]
      Option Compare Database

      Private Sub Mails_ablegen_Click()
      Dim olAppl As Outlook.Application
      Dim olNS As Outlook.NameSpace

      Set olAppl = New Outlook.Application
      Set olNS = olAppl.GetNamespace(\”MAPI\”)
      MailsSichern (olNS.GetDefaultFolder(olFolderInbox).Folders(\”Postbuch\”))
      Set olNS = Nothing
      Set olAppl = Nothing
      DoCmd.Close
      DoCmd.OpenForm \”Frm_Postbuch\”
      DoCmd.Maximize
      MsgBox \”Verarbeitung beendet!\”
      End Sub

      Public Sub MailsSichern(ByRef Out As Outlook.MAPIFolder)
      On Error GoTo fehler
      Dim intGes As Integer
      Dim intz As Integer
      Dim inty As Integer
      Dim Conn As New ADODB.Connection
      Dim DBS As ADODB.Recordset
      Dim Conn2 As New ADODB.Connection
      Dim DBS2 As ADODB.Recordset
      Dim OutMail As Object
      Dim intAnhZ As Integer
      Dim OutMapi As New Outlook.Application
      Dim OutVerz As Object
      Dim intV As Integer
      Dim intAnhZ2 As Integer
      Dim Nummer As Long

      DoCmd.GoToRecord , , acLast
      Set Conn = CurrentProject.Connection
      Set Conn2 = CurrentProject.Connection
      Set DBS = New ADODB.Recordset
      Set DBS2 = New ADODB.Recordset
      Set OutVerz = OutMapi.GetNamespace(\”MAPI\”) _
      .GetDefaultFolder(olFolderInbox).Folders(\”Postbuch\”)
      Set Conn = CurrentProject.Connection
      Nummer = 1
      DBS2.Open \”tab_Anlage\”, Conn, adOpenKeyset, adLockOptimistic
      DBS.Open \”Tab_Postbuch\”, Conn, adOpenKeyset, adLockOptimistic
      intGes = Out.Items.Count
      intz = 0
      inty = ID
      For intz = intGes To 1 Step -1
      With Out.Items(intz)
      inty = inty + 1
      DBS.AddNew
      DBS!Titel = \”PB-09 \” & inty & \” \” & .Subject
      DBS!Erfassungsdatum = Date
      DBS!Erfasser = \”A-\” & fOSUserName()
      DBS!Absender = .SenderName
      DBS!Kopie_Empfänger = .CC
      DBS!Blindkopie_Empfänger = .BCC
      DBS!Empfänger = .To
      DBS!Wichtigkeit = .Importance
      DBS!Inhalt = .Body
      DBS!Erhalten = Format(.ReceivedTime, \”dd.mm.yyyy hh:mm\”)
      DBS!Erstellt_am = Format(.CreationTime, \”dd.mm.yyyy hh:mm\”)
      DBS!Gesendet = Format(.SentOn, \”dd.mm.yyyy hh:mm\”)
      DBS!Letzte_Bearbeitung = _
      Format(.LastModificationTime, \”dd.mm.yyyy hh:mm\”)
      DBS!Übertragung = _
      Format(.DeferredDeliveryTime, \”dd.mm.yyyy hh:mm\”)
      DBS!Anhang = .Attachments.Count
      DBS!Größe = .Size
      If Not .UnRead = -1 Then
      DBS!Gelesen = \”JA\”
      Else
      DBS!Gelesen = \”Nein\”
      End If
      DBS.Update
      End With
      Set OutMail = OutVerz.Items(intz)
      If OutMail.Attachments.Count > 0 Then
      For intAnhZ2 = 1 To OutMail.Attachments.Count
      If OutMail.Attachments.Item(intAnhZ2).Type = \”5\” Then
      Ext = \”.msg\”
      Else
      Ext = \”\”
      End If
      OutMail.Attachments.Item(intAnhZ2).SaveAsFile \”D:\\Post\\\” & _
      \”Post-09 \” & inty & \” \” & \”(\” & Nummer & \”)\” & _
      Austausch(OutMail.Attachments.Item(intAnhZ2)) & Ext
      DBS2.AddNew
      DBS2!Anlage = \”Post-09 \” & inty & \” \” & \”(\” & Nummer & \”)\” & _
      Austausch(OutMail.Attachments.Item(intAnhZ2)) & Ext
      DBS2!Datum = Date
      DBS2!Betreff = DBS!Titel
      DBS2.Update
      Nummer = Nummer + 1
      Next intAnhZ2
      Nummer = 1
      End If
      Set OutMail = Nothing
      Next intz
      DBS.Close
      With DBS
      .CursorLocation = adUseClient
      .Open \”Tab_Postbuch\”, Conn, adOpenKeyset, adLockOptimistic
      .Sort = \”Erhalten ASC\”
      End With
      Set DBS = Nothing
      Set Conn = Nothing
      Exit Sub
      fehler:
      MsgBox Err.Number & \” \” & Err.Description
      End Sub
      [/code]

      #173584
      Unbekannt
      Teilnehmer

        Problem gelöst.
        Trotzdem Danke ans Forum

      2 Antworten anzeigen - 1 bis 2 (von insgesamt 2)

      Hat Ihnen der Beitrag gefallen?

      1 Stern2 Sterne3 Sterne4 Sterne5 Sterne (Keine Bewertung vorhanden)
      Loading...