andere Postfächer in Outlook per VBA abrufe

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]