Solved Outlook VBA Cant figure out what I’m doing wrong. (1 Viewer)

FAB1

Registered User.
Local time
Today, 07:08
Joined
Jul 27, 2007
Messages
40
Hi All, I had been playing about with some code in Outlook to export emails details to Access. For testing I had changed the code to export from a sub folder with a small sample set of emails that worked no problems. But when I changed it to work on the Inbox it fails after exporting about a quarter of 17,083 I get the
Run-time error ‘13’: Type Mismatch which fails on Next.
I can understand Type mismatch normally being Datetime values being put into wrong field types etc but it did work before on the small sample?

Help

Code:
    Public Sub ExportInbox()
    
    Dim oApp As Outlook.Application
    Dim oAccess As Access.Application
    Dim wrkAccess As Workspace
    Dim MyDB As DAO.Database
    Dim oInbox As Outlook.MAPIFolder
    Dim oInboxItems As Outlook.Items
    Dim oMail As Outlook.MailItem
    Dim rst As DAO.Recordset
    

    Set oApp = New Outlook.Application
    Set oInbox = oApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    Set oInboxItems = oInbox.Items
    
    Set oAccess = New Access.Application

    'Create Microsoft Access Workspace and Database Objects
    Set wrkAccess = oAccess.DBEngine.CreateWorkspace("", "admin", "", dbUseJet)
    Set MyDB = wrkAccess.OpenDatabase("C:\Test\Test.accdb", True)

    Set rst = MyDB.OpenRecordset("tblEMails", dbOpenDynaset)

    For Each oMail In oInboxItems
    
      With rst
        .AddNew
      ![ImportedEntryID] = oMail.EntryID
      ![ImportedFromEmailAddress] = oMail.SenderEmailAddress
      ![ImportedSenderName] = oMail.SenderName
      ![ImportedTo] = oMail.To
      ![ImportedCC] = oMail.CC
      ![ImportedBCC] = oMail.BCC
      ![ImportedSubject] = oMail.Subject
      ![ImportedBody] = oMail.Body
      ![ImportedBodyHTML] = oMail.HTMLBody
      ![ImportedReceivedStamp] = oMail.ReceivedTime
         .Update
      End With
  Next    `<-- Fails here
 
  'oApp.Quit
  oAccess.Quit
    rst.Close
    Set oApp = Nothing
    Set oAccess = Nothing
    Set rst = Nothing
    
    End Sub
 

Isaac

Lifelong Learner
Local time
Yesterday, 23:08
Joined
Mar 14, 2017
Messages
2,693
Looping through outlook folders requires code that more carefully examines the type of item.
For example ... You declare oMail as a MailItem object, but then are looping through all items in the Inbox, which may contain meeting items or even other types of items. You probably need to adjust your code to examine the type of item, and, only if it's a MailItem, set oMail to Items(x)

Code:
For x = 0 to OInboxItems.Count
   If type=mailitem then
       set oMail=OInboxItems(x)
       ...etc
   End if
Next X

...That is just air code as a rough demonstration, but may help get started.
 

namliam

The Mailman - AWF VIP
Local time
Today, 08:08
Joined
Aug 11, 2003
Messages
11,677
what item did it import last? That is where it got stuck and your next item isnt a Mail item
Perhaps some attachment, calander invite or some other sort that it cannot handle as a "MailItem"
 

FAB1

Registered User.
Local time
Today, 07:08
Joined
Jul 27, 2007
Messages
40
Thanks @Isaac & @namliam for the push in the right direction. I also tied it in with code from Diane Poremsky https://forums.slipstick.com which if added to the “ThisOultlookSession” followed by a 1 time outlook close then open again will start adding new received emails to the accdb. Thanks again

Code:
Option Explicit
Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
‘’ Code by Diane Poremsky @ https://forums.slipstick.com
  Dim olApp As Outlook.Application
  Dim objNS As Outlook.NameSpace
  Set olApp = Outlook.Application
  Set objNS = olApp.GetNamespace("MAPI")
  ' default local Inbox
  Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub Items_ItemAdd(ByVal item As Object)

On Error Resume Next

    Dim oApp As Outlook.Application
    Dim oAccess As Access.Application
    Dim wrkAccess As Workspace
    Dim MyDB As DAO.Database
    Dim rst As DAO.Recordset
    
    Set oAccess = New Access.Application
    Set wrkAccess = oAccess.DBEngine.CreateWorkspace("", "admin", "", dbUseJet)
    Set MyDB = wrkAccess.OpenDatabase("C:\Test\Test.accdb", True)
    Set rst = MyDB.OpenRecordset("tblEMails", dbOpenDynaset)


  Dim Msg As Outlook.MailItem
  If TypeName(item) = "MailItem" Then
    Set Msg = item
    ' ******************
    ' do something here
    ' ******************
  'MsgBox Msg.Subject
 
    For Each Msg In item
        
  With rst
 .AddNew
 
      ![ImportedEntryID] = Msg.EntryID
      ![ImportedFromEmailAddress] = Msg.SenderEmailAddress
      ![ImportedSenderName] = Msg.SenderName
      ![ImportedTo] = Msg.To
      ![ImportedCC] = Msg.CC
      ![ImportedBCC] = Msg.BCC
      ![ImportedSubject] = Msg.Subject
      ![ImportedBody] = Msg.Body
      '![ImportedBodyRTF] = oMail.RTFBody    ''Failed ?
      ![ImportedBodyHTML] = Msg.HTMLBody  '' Worked add later
      ![ImportedReceivedStamp] = Msg.ReceivedTime
      ![ImportedSentStamp] = Msg.SentOn
      .Update
      End With
    
'End If
Next Msg

  oAccess.Quit
    rst.Close
    Set oApp = Nothing
    Set oAccess = Nothing
    Set rst = Nothing
    End If
    
    End Sub
 

Isaac

Lifelong Learner
Local time
Yesterday, 23:08
Joined
Mar 14, 2017
Messages
2,693
Awesome, glad you got things sorted out!
 

Users who are viewing this thread

Top Bottom