Advertisement
Guest User

Untitled

a guest
Jan 17th, 2017
99
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.23 KB | None | 0 0
  1. Sub impOutlookTable()
  2. ' point to the desired email
  3. Const strMail As String = "bahadir.kara@alacergold.com"
  4. Dim oApp As Outlook.Application
  5. Dim oMapi As Outlook.MAPIFolder
  6. Dim oMail As Outlook.MailItem
  7.  
  8.  
  9.  
  10. On Error Resume Next
  11. Set oApp = GetObject(, "OUTLOOK.APPLICATION")
  12. If (oApp Is Nothing) Then Set oApp = CreateObject("OUTLOOK.APPLICATION")
  13. On Error GoTo 0
  14.  
  15. Set oMapi = oApp.GetNamespace("MAPI").Folders(strMail).Folders("Inbox").Folders("AMEC-DCC -DS- TRANSMITTAL")
  16. Set oMail = oMapi.Items(oMapi.Items.Count)
  17.  
  18. ' get html table from email object
  19. For Each oMail In oMapi.Items
  20. Dim oHTML As MSHTML.HTMLDocument: Set oHTML = New MSHTML.HTMLDocument
  21. Dim oElColl As MSHTML.IHTMLElementCollection
  22. With oHTML
  23. .Body.innerHTML = oMail.HTMLBody
  24. Set oElColl = .getElementsByTagName("p")
  25. End With
  26.  
  27.  
  28. 'import in Excel
  29. Dim x As Long, y As Long, counter As Long
  30.  
  31. SonSatir = Range_End_Method() + 1
  32. On Error Resume Next
  33. For x = 0 To oElColl(0).Rows.Length - 1
  34. On Error Resume Next
  35.  
  36. For y = 0 To oElColl(0).Rows(x).Cells.Length - 1
  37. Range("A" & SonSatir).Offset(x, y).Value = oElColl(0).Rows(x).Cells(y).innerText
  38. Next y
  39.  
  40. Next x
  41.  
  42. Set oApp = Nothing
  43. Set oMapi = Nothing
  44. Set oMail = Nothing
  45. Set oHTML = Nothing
  46. Set oElColl = Nothing
  47.  
  48. Next
  49.  
  50. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement