Outlook belli bir konuya sahip html gövdesini excel aktarma hk.

[denizfatihi]

Merhaba,

Outlook'ta belli bir koyuya ait maillerin html'den excel'e geçişlerini nasıl elde edebilir?
Konu kısaca söyle "Haftalık Çalışma Süreleri (Saat)" konusuna ait yaklaşık 550 adet mail var bu mailleri bir çevrim içi buldukları bunların içinde yer alan
Adı Soyadı, Tarih, Giriş_Saati, Çıkış_Saati şeklinde excelde tablo oluşturmak istiyorum aşağıdaki kodu buldum yalnız çalıştırdık bir süre sonra

"object variable or with block variable not set"

hatası veriyor hata bilgisi ayrıntısı da

".Body.innerHTML = oMail.HTMLBody"

bu hatalı nasıl aşarım veya farklı bir koruyucuz var ise onu da belirtmenizi rica ederim.

Yardımınız ve desteğiniz için teşekkür ederim.

Sub impOutlookTable()

Dim wkb As Workbook
'Dim wks As Worksheet
  ' Set wks = ActiveSheet
  'wks.Name = "Sayfa1"
Set HTMLdoc = New MSHTML.HTMLDocument
' Set oMapi = oApp.GetNamespace("MAPI").Folders(strMail).Folders("Gelen Kutusu")
Set wkb = Workbooks.Add
' wks.Name = "Sayfa1"

Sheets("Sayfa1").Cells.ClearContents

' point to the desired email
Const strMail As String = "insankaynaklari@abc.com.tr"

Dim oApp As Outlook.Application
Dim oMapi As Outlook.MAPIFolder
Dim oMail As Outlook.MailItem
Dim tables As MSHTML.IHTMLElementCollection
Dim table As MSHTML.HTMLTable

On Error Resume Next
Set oApp = GetObject(, "OUTLOOK.APPLICATION")
If (oApp Is Nothing) Then Set oApp = CreateObject("OUTLOOK.APPLICATION")

On Error GoTo 0

'Set oMapi = oApp.GetNamespace("MAPI").Folders(strMail).Folders("inbox")
Set oMapi = oApp.GetNamespace("MAPI").Folders(strMail).Folders("Gelen Kutusu")
'Set oMail = oMapi.Items(oMapi.Items.Count)
For i = 1 To oMapi.Items.Count
  If oMapi.Items.Item(i).Subject = "Haftalık Çalışma Süreleri (Saat)" Then
    'Some code here
  End If
Next i

' get html table from email object
Dim oHTML As MSHTML.HTMLDocument: Set oHTML = New MSHTML.HTMLDocument
Dim oElColl As MSHTML.IHTMLElementCollection
With oHTML
    .Body.innerHTML = oMail.HTMLBody
    Set oElColl = .getElementsByTagName("table")
End With

'import in Excel
Dim x As Long, y As Long
For x = 0 To oElColl(0).Rows.Length - 1
    For y = 0 To oElColl(0).Rows(x).Cells.Length - 1
        Range("A1").Offset(x, y).Value = oElColl(0).Rows(x).Cells(y).innerText
    Next y
Next x

Set oApp = Nothing
Set oMapi = Nothing
Set oMail = Nothing
Set oHTML = Nothing
Set oElColl = Nothing

wkb.SaveAs "C:\Users\user\Desktop\saat_tablosu.xlsx"

End Sub