cobianna
asked on
Runtime Error 438 Object doesn't support this property or object
I am using the following code:
Private Sub btnNewMail_Click()
Dim colItems As Outlook.Items
Dim objCurrentItem As Object
Dim strSQL As String
Dim dbs As Database
Dim tdf As TableDef
Dim rst As DAO.Recordset
Dim intDuplicates As Integer
Dim intI As Integer
Dim Attachment9 As String
Dim dummy As String
On Error GoTo Error_btnNewMail_Click
Set colItems = GetMailboxNetworkInput(Me. cmbMap, Me.cmbFolder)
If colItems Is Nothing Then
MsgBox "No items found"
Else
' Return Database object variable pointing to current database.
Set dbs = CurrentDb
' Return TableDef object variable pointing to Mail table.
Set rst = dbs.OpenRecordset("Mail")
' Add to table Mail
'DoCmd.Hourglass True
DoCmd.SetWarnings False
For Each objCurrentItem In colItems
DoEvents
If Not fncMailExist(objCurrentIte m.EntryID) Then
rst.AddNew
rst!EntryID = objCurrentItem.EntryID
rst!ReceivedTime = objCurrentItem.ReceivedTim e
rst!Subject = objCurrentItem.Subject
rst!SenderName = objCurrentItem.SenderName
rst!CC = objCurrentItem.CC
rst!Body = fncReplaceTabs(objCurrentI tem.Body)
rst!Attachments = objCurrentItem.Attachments .Count
'rst.Update
'Save attachments in c:\temp
Attachment9 = ""
If objCurrentItem.Attachments .Count > 0 Then
For intI = 1 To objCurrentItem.Attachments .Count
objCurrentItem.Attachments .Item(intI ).SaveAsFi le ("T:\Cost Mailbox\Mail Attachments\" & objCurrentItem.Attachments .Item(intI ))
Attachment9 = Attachment9 & "," & objCurrentItem.Attachments .Item(intI )
Next intI
End If
rst!AttachmentsName = Mid(Attachment9, 2)
rst.Update
Else
intDuplicates = intDuplicates + 1
If intDuplicates = 1 Then MsgBox "Duplicate emails were found. These items will not be imported into the log."
End If
Next objCurrentItem
DoCmd.SetWarnings True
'DoCmd.Hourglass False
rst.Close
Set rst = Nothing
Set dbs = Nothing
End If
Me.Refresh
GoTo Exit_btnNewMail_Click
Error_btnNewMail_Click:
Select Case Err
Case 3022, 6
Resume Next
Case Else
MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
End Select
Exit_btnNewMail_Click:
MsgBox "Emails have been logged into the Database.", vbOKOnly, "Get Emails"
End Sub
When I click on the button that runs this, I get "Error 438 Object doesn't support this property or object". Can someone tell me why this is happening and how to fix it?
Private Sub btnNewMail_Click()
Dim colItems As Outlook.Items
Dim objCurrentItem As Object
Dim strSQL As String
Dim dbs As Database
Dim tdf As TableDef
Dim rst As DAO.Recordset
Dim intDuplicates As Integer
Dim intI As Integer
Dim Attachment9 As String
Dim dummy As String
On Error GoTo Error_btnNewMail_Click
Set colItems = GetMailboxNetworkInput(Me.
If colItems Is Nothing Then
MsgBox "No items found"
Else
' Return Database object variable pointing to current database.
Set dbs = CurrentDb
' Return TableDef object variable pointing to Mail table.
Set rst = dbs.OpenRecordset("Mail")
' Add to table Mail
'DoCmd.Hourglass True
DoCmd.SetWarnings False
For Each objCurrentItem In colItems
DoEvents
If Not fncMailExist(objCurrentIte
rst.AddNew
rst!EntryID = objCurrentItem.EntryID
rst!ReceivedTime = objCurrentItem.ReceivedTim
rst!Subject = objCurrentItem.Subject
rst!SenderName = objCurrentItem.SenderName
rst!CC = objCurrentItem.CC
rst!Body = fncReplaceTabs(objCurrentI
rst!Attachments = objCurrentItem.Attachments
'rst.Update
'Save attachments in c:\temp
Attachment9 = ""
If objCurrentItem.Attachments
For intI = 1 To objCurrentItem.Attachments
objCurrentItem.Attachments
Attachment9 = Attachment9 & "," & objCurrentItem.Attachments
Next intI
End If
rst!AttachmentsName = Mid(Attachment9, 2)
rst.Update
Else
intDuplicates = intDuplicates + 1
If intDuplicates = 1 Then MsgBox "Duplicate emails were found. These items will not be imported into the log."
End If
Next objCurrentItem
DoCmd.SetWarnings True
'DoCmd.Hourglass False
rst.Close
Set rst = Nothing
Set dbs = Nothing
End If
Me.Refresh
GoTo Exit_btnNewMail_Click
Error_btnNewMail_Click:
Select Case Err
Case 3022, 6
Resume Next
Case Else
MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
End Select
Exit_btnNewMail_Click:
MsgBox "Emails have been logged into the Database.", vbOKOnly, "Get Emails"
End Sub
When I click on the button that runs this, I get "Error 438 Object doesn't support this property or object". Can someone tell me why this is happening and how to fix it?
ASKER
The error occured at the following line:
rst!ReceivedTime = objCurrentItem.ReceivedTim e
Any suggestions?
rst!ReceivedTime = objCurrentItem.ReceivedTim
Any suggestions?
So I presume that GetMailboxNetworkInput returns the collection of mails from a specific folder in Outlook?
What is the code in GetMailboxNetworkInput ?
Is there a particular reason that you declare
Dim objCurrentItem As Object
instead of
Dim objCurrentItem As Outlook.MailItem
Does the collection not iterate if you do that?
What is the code in GetMailboxNetworkInput ?
Is there a particular reason that you declare
Dim objCurrentItem As Object
instead of
Dim objCurrentItem As Outlook.MailItem
Does the collection not iterate if you do that?
ASKER
Here is the code for "GetMailboxNetworkInput":
Function GetMailboxNetworkInput(str MapNameLik e As String, strFolderName As String) As Outlook.Items
' This procedure returns the items of the Outlook mailbox folder. *
' That is identified by: *
' strMapNameLike = unique "Instr" part of MAP from outlook *
' strFoldername = name of folder *
' These variables have been specified to be able to identify the "Input" folder of the *
' correct mailbox *
' For the use within this application normally "Network" and "Input" will be specified *
Dim colMaps As Outlook.Folders
Dim colFolders As Outlook.Folders
Dim fldFolder As Outlook.MAPIFolder
Dim fldMap As Outlook.MAPIFolder
' Use the InitializeOutlook procedure to initialize global
' Application and NameSpace object variables, if necessary.
If golApp Is Nothing Then
If InitializeOutlook = False Then
MsgBox "Unable to initialize Outlook Application " _
& "or NameSpace object variables!"
Exit Function
End If
End If
Set colMaps = gnspNameSpace.Folders
For Each fldMap In colMaps
If InStr(fldMap.Name, strMapNameLike) > 0 Then
Set colFolders = fldMap.Folders
For Each fldFolder In colFolders
If fldFolder.Name = strFolderName Then
Set GetMailboxNetworkInput = fldFolder.Items
Exit Function
End If
Next fldFolder
Set GetMailboxNetworkInput = Nothing
End If
Next fldMap
End Function
I did not create this code so I'm not sure why they would have used As Object instead of As Outlook.MailItem.
Function GetMailboxNetworkInput(str
' This procedure returns the items of the Outlook mailbox folder. *
' That is identified by: *
' strMapNameLike = unique "Instr" part of MAP from outlook *
' strFoldername = name of folder *
' These variables have been specified to be able to identify the "Input" folder of the *
' correct mailbox *
' For the use within this application normally "Network" and "Input" will be specified *
Dim colMaps As Outlook.Folders
Dim colFolders As Outlook.Folders
Dim fldFolder As Outlook.MAPIFolder
Dim fldMap As Outlook.MAPIFolder
' Use the InitializeOutlook procedure to initialize global
' Application and NameSpace object variables, if necessary.
If golApp Is Nothing Then
If InitializeOutlook = False Then
MsgBox "Unable to initialize Outlook Application " _
& "or NameSpace object variables!"
Exit Function
End If
End If
Set colMaps = gnspNameSpace.Folders
For Each fldMap In colMaps
If InStr(fldMap.Name, strMapNameLike) > 0 Then
Set colFolders = fldMap.Folders
For Each fldFolder In colFolders
If fldFolder.Name = strFolderName Then
Set GetMailboxNetworkInput = fldFolder.Items
Exit Function
End If
Next fldFolder
Set GetMailboxNetworkInput = Nothing
End If
Next fldMap
End Function
I did not create this code so I'm not sure why they would have used As Object instead of As Outlook.MailItem.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Just comment out the line
'On Error GoTo Error_btnNewMail_Click
It could be occuring in your called procedures
GetMailboxNetworkInput, fncMailExist or fncReplaceTabs