Hi,
I am trying (for the first time ever) to access Outlook_items from Excel.
I have found some code in another forum (at herber.de) and
commented it, trying to understand line by line what it's doing, and adapted it.
I can paste it here:
Code:
Option Explicit
Sub email_Anhang_speichern_und_übergeben()
Dim objOL As Object, objFolder As Object 'Es werden mehrere Objektinstanzen erzeugt
'("late binding", die Objektinstanzen sind noch unspezifiziert)
Dim strPath As String
Dim lngIndex As Long, lngCur As Long, lngCount As Long, lngRow As Long
Dim lngCalc As Long
On Error GoTo ErrExit 'Hier werden Fehler durch eine eigene Prozedur abgefangen.
With Application 'Das Makro läuft in Excel.
.ScreenUpdating = False 'Indem der Bildschirm nicht andauernd aktualisiert wird, geht es schneller
.EnableEvents = False
lngCalc = .Calculation 'Hier wird eigtl nichts eingestellt, es wird nur eine Variable befüllt
.Calculation = xlCalculationManual 'Da das Makro in Excel läuft, wird einfach auf manuelle Neuberechnung umgestellt.
.DisplayAlerts = False
End With
strPath = "S:\Common\40_Werksentwicklung\04-KPI_QlikView\105_Sonderaufgaben_FHofmann\VBA\Outlook" 'In diesen Pfad soll der Anhang
'gespeichert werden
strPath = IIf(Right(strPath, 1) = "\", strPath, strPath & "\")
Set objOL = CreateObject("Outlook.Application")
Set objFolder = objOL.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
lngCount = objFolder.Items.Count 'Das ist die Anzahl von emails im Posteingang
lngRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row 'Hier wird einfach die erste freie Zelle in Spalte A gesucht
For lngCur = 1 To lngCount 'Alle emails im ?Posteingang? werden durchlaufen
Application.StatusBar = "Lese Posteingang " & _
Format(lngCur / lngCount, "0%") 'In der Statuszeile wird einiges angezeigt
With objFolder.Items(lngCur) 'Durch diese WITH-Schleife kann die Nennung des Objekts
'bei den nächsten Befehlen entfallen
If .Subject = "FX Rates *" Then
lngRow = lngRow + 1
Cells(lngRow, 1).Value = .Subject
Cells(lngRow, 2).Value = .ReceivedTime
Cells(lngRow, 3).Value = .SenderName
Cells(lngRow, 4).Value = .SenderEmailAddress
Cells(lngRow, 5).Value = .Body
Cells(lngRow, 6).Value = .Attachments.Count
If .Attachments.Count > 0 Then
For lngIndex = 1 To .Attachments.Count
Debug.Print strPath & .Attachments.Item(lngIndex).FileName 'Ausgabe im Direktfenster! (Strg+G)
.Attachments.Item(lngIndex).SaveAsFile strPath & .Attachments.Item(lngIndex).FileName
Next
End If
.UnRead = False 'als gelesen markieren
'.Delete 'Löschen
End If
End With
Next
[A2].Select
ActiveWorkbook.Saved = True
ErrExit:
With Err
If .Number <> 0 Then
MsgBox "Fehler in Prozedur:" & vbTab & "'OutlookPosteingang'" & vbLf & String(60, "_") & _
vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
"Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
.Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
"VBA - Fehler in Modul - Modul1"
.Clear
End If
End With
On Error GoTo 0
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = lngCalc
.DisplayAlerts = True
.StatusBar = False
End With
Set objFolder = Nothing
Set objOL = Nothing
End Sub
Before running that, I have activated the "Microsoft Outlook 15.0 Object library" - there was nothing about that in the thread, but I thought it might be necessary?)
The error occurs at the point where the code fills the variable lngCount - that is supposed to be the nr. of items in the Inbox. But the Count is too low by approx. 400 items (comparing with the nr. in the statusbar in Outlook)
Can someone give me a hint as to what's going wrong here?
Thanks a lot!
Best regards,
Officer_Bierschnitt