Laufzeitfehler bei Objektvariable
27.02.2015 09:14:38
Werner
Ich haben die das Skript nochmal geändert. Nun bekomme ich aber Laufzeitfehler:
Objektvariable oder With-Blockvariable nicht festgelegt
Ich komme da nicht weiter. Wenn jemand eine Idee hat wäre ich dankbar.
----------------------------------------
Sub TestOutlookMails()
Dim olApp As Object ' das Outlook-Objekt
Dim objFolder As Object ' der Standard-Posteingangsordner
Dim objItem As Object ' ein Objekt in objFolder
Dim i As Long ' Zeilennummer
Dim objRe As Object ' ein Regular-Expression Objekt
Dim objMc As Object ' eine MatchCollection, das Ergebnis von objRe.Execute
Dim objMatch As Object ' ein Match, d.h. ein Eintrag der Form "irgendwas:sonstwas"
Dim objDic As Object ' ein Dictionary-Objekt, Key sind die möglichen Werte vor dem _
Doppelpunkt, Item ist die Spaltenummer wo das hinsoll
Dim varKey As Variant ' ein Key im Dictionary
Dim strKey As String ' dito
Set objDic = CreateObject("scripting.dictionary")
i = 1
Cells(1, 1).Value = "Betreff"
For Each varKey In Array("Auftragsnummer", "Kundenname", "Kundenanschrift", "Mitarbeiter", " _
Bewertung", "Datum")
i = i + 1
objDic(varKey) = i
Cells(1, i).Value = varKey
Next
Set objRe = CreateObject("vbscript.regexp")
objRe.Global = True
objRe.MultiLine = True
objRe.Pattern = "^(.*?):[ \t]*(.*?)[\r\n]?$"
Set olApp = CreateObject("outlook.application")
'Set objFolder = olApp.GetNameSpace("MAPI").GetDefaultFolder(6) ' 6 = olFolderInbox _
' nur Posteingang funktioniert
'Set objFolder = olApp.GetNamespace("MAPI").GetDefaultFolder(6).Folders("Meldung").Folders(" _
Extra") 'Posteingang mit Unterordner funktioniert
Set olFolderInbox = olApp.Session.Folders("WR_Kundenabfrage").Folders("Posteingang") _
' in Outlook anderes E-Mail Konto - geht nicht
i = 2
For Each objItem In objFolder.Items
If TypeName(objItem) = "MailItem" Then
Set objMc = objRe.Execute(objItem.Body)
If objMc.Count > 0 Then
Cells(i, 1).Value = objItem.Subject
For Each objMatch In objMc
strKey = objMatch.Submatches(0)
If objDic.Exists(strKey) Then Cells(i, objDic(strKey)) = objMatch.Submatches(1)
Next
i = i + 1
End If
End If
Next
objDic.RemoveAll
Set objDic = Nothing
Set objMc = Nothing
Set objRe = Nothing
Set objFolder = Nothing
Set olApp = Nothing
End Sub