Home > Blockchain >  Type Mismatch Error - Trying to write a sub that extracts a table from an email and copies to excel
Type Mismatch Error - Trying to write a sub that extracts a table from an email and copies to excel

Time:10-31

Would really appreciate if someone can weigh in on this :)

What Im trying to achieve is to grab a specific email from outlook with current date and specified subject. After this I want to copy the contents of the email (a table) to the active excel sheet. Im already looping through a generic object.

Sub Mail3()


Dim Folder As Outlook.MAPIFolder
Dim sFolders As Outlook.MAPIFolder
Dim MailBoxName As String, Pst_Folder_Name  As String
Dim oMail As Object
Dim y As Long, x As Long
Dim olInsp As Outlook.Inspector
Dim wdDoc As Word.Document
Dim tb As Word.Table
Dim Myemail As String
Dim Atmt As Attachment
Dim irow As Integer
Dim oItem As Outlook.MailItem
Dim ns As Namespace
irow = 1
'set email date
Set ns = GetNamespace("MAPI")

Myemail = "abcd"
'Mailbox or PST Main Folder Name to set the name of the inbox - I have several mailboxes, needed to specify
 MailBoxName = "myinbox"

'Mailbox Folder or PST Folder Name (As how it is displayed in your Outlook Session)
 Pst_Folder_Name = "Inbox" 'Sample "Inbox" or "Sent Items"

'To direct to a Folder at a high level
 Set Folder = Outlook.Session.Folders(MailBoxName).Folders(Pst_Folder_Name)

'copying the email contents into the refresh file
For Each oMail In Folder.Items
 If oMail.Class = 43 Then
    Set oMail = oItem
        If oMail.Subject = Myemail And (Now() - oMail.ReceivedTime) < 1 Then
         
              'oMail.SentOn = DateSerial(Year(Now), Month(Now), Day(Now)) Then
                
                Application.ThisWorkbook.Worksheets("Sheet1").Range("B9").Value = oItem.HTMLBody
            
        End If
  End If
Next oMail
  

    
End Sub

Bare in my mind that Im learning VBA and this code isnt entirely my creation.

Edit:

Ok so ive changed a bunch of things. This time using oMail as Object

Still getting an object not definined error here Application.ThisWorkbook.Worksheets("Sheet1").Range("B9").Value = oItem.HTMLBody

CodePudding user response:

Still getting an object not definined error here

Application.ThisWorkbook.Worksheets("Sheet1").Range("B9").Value = oItem.HTMLBody

You need to use the oMail object instead:

Application.ThisWorkbook.Worksheets("Sheet1").Range("B9").Value = oMail.HTMLBody

Also iterating over all items in the folder is not really a good idea. Instead, use the Find/FindNext or Restrict methods of the Items class where you can deal only with items that correspond to the search criteria defined. Read more about them in the following articles that I wrote for the technical blog:

Finally, you may also find the Filtering Items Using a Date-time Comparison article helpful.

CodePudding user response:

This sequence sets oMail to nothing.

For Each oMail In Folder.Items
    If oMail.Class = 43 Then
        Set oMail = oItem

You may declare variables this way.

Dim oItem As Object
Dim oMail As Outlook.MailItem

Test in whatever way you wish that oItem is a mailitem.

Option Explicit

Sub Mail3_DifferentVariableNames()

Dim oFolder As Outlook.Folder

Dim MailBoxName As String
Dim High_Level_Folder_Name  As String

Dim oItem As Object
Dim oMail As Outlook.MailItem

Dim mySubject As String

mySubject = "abcd"

MailBoxName = "myEmailAddress"

'Folder immediately under MailBoxName
High_Level_Folder_Name = "Inbox" 'Sample "Inbox" or "Sent Items"

Set oFolder = Session.Folders(MailBoxName).Folders(High_Level_Folder_Name)

'copying the email contents into the refresh file
For Each oItem In oFolder.Items

    If oItem.Class = 43 Then
    
        Set oMail = oItem
        
        ' If noticeably slow there are methods to reduce the number of items processed.
        If oMail.Subject = mySubject And (Now() - oMail.ReceivedTime) < 1 Then
            ThisWorkbook.Worksheets("Sheet1").Range("B9").Value = oMail.HTMLBody
        End If
        
    End If
    
Next
    
End Sub
  • Related