Hi All,

I use a code to check for new emails coming in and move them to a
designated location.
The code for the Redemption that I use doesn't work:
In RETRIEVE_MAIL it fails at:
Set olMailItem = olInbox.Items.Item(iteller) 'TYPE MISMATCH


Dim WithEvents myInboxMailItem As Outlook.Items

Private Sub myInboxMailItem_ItemAdd(ByVal Item As Object)
Call RETRIEVE_MAIL
End Sub

Private Sub Initialize_Handler()

Dim fldInbox As Outlook.MAPIFolder
Dim gnspNameSpace As Outlook.NameSpace

Set gnspNameSpace = Outlook.GetNamespace("MAPI") 'Outlook Object
Set fldInbox = gnspNameSpace.Folders("Mailbox SB").Folders("Postvak
IN")
Set myInboxMailItem = fldInbox.Items

End Sub

Private Sub Application_Startup()
Call Initialize_Handler
End Sub


Public Function RETRIEVE_MAIL()

Dim olApplication As Outlook.Application
Dim oNamespace As Object
Dim olInbox As Outlook.MAPIFolder
Dim olDeleteFolder As Outlook.MAPIFolder
Dim olMailItem As Redemption.SafeMailItem
'Outlook.MailItem
Dim olMailItemBody As String
Dim fsoWindows As FileSystemObject
Set fsoWindows = CreateObject("scripting.filesystemobject")
Dim bGevonden As Boolean
Dim slijst As String
Dim Gwerkdir As String
Dim iteller As Integer
Dim iteller1 As Integer
Dim iteller2 As Integer
Dim inttotteller As Integer
Dim woord As String
Dim iaantalitems As Integer
Dim strmailopslag As String

strmailopslag = "J:\BIN\TEMP
\" ' locatie waar de
mail opgeslagen wordt!!!!!!

Set olMailItem = CreateObject("Redemption.SafeMailItem")
Set olApplication = CreateObject("Outlook.Application")
Set oNamespace = olApplication.GetNamespace("MAPI")
Set olInbox = oNamespace.Folders("Mailbox SB").Folders("Postvak IN")
Set olDeleteFolder = oNamespace.Folders("Mailbox
SB").Folders("Verwijderde items").Folders("OUD")
Set fsoWindows = CreateObject("Scripting.FileSystemObject")
iaantalitems = 0
iteller = 1
iteller2 = 0
bGevonden = False
woord = ""
Do While iteller = olInbox.Items.Count
Set olMailItem = olInbox.Items.Item(iteller) 'TYPE MISMATCH
bGevonden = False
If TypeName(olMailItem) = "MailItem" Then
If olMailItem.SenderName = "KD" Or olMailItem.SenderName =
"HN" Or olMailItem.SenderName = "NI" Or olMailItem.SenderName = "KB"
Then
bGevonden = True
Select Case olMailItem.Attachments.Count
Case 0 ' er is dus geen attachments!!
olMailItemBody = olMailItem.Body
woord = olMailItem.Fields(PR_SUBJECT)
'woord = checkfile(woord)
olMailItem.SaveAs strmailopslag & woord &
".txt"
Case Else ' er zijn wel attachments!!
For iteller2 = 1 To
olMailItem.Attachments.Count
woord =
olMailItem.Attachments.Item(iteller2).DisplayName
' in de opmaak van de TK bestanden
bevindt zich een Paintbrush Picture, deze willen we niet hebben...
If InStr(UCase(woord), "PAINTBRUSH") =
0 Then
' we moeten eerst nog even
controleren of er al geen dubbele bestanden in de CIU staan.
' alle "eventuele" dubbele
bestanden worden nu met dubbel aangeduid.
Do While
fsoWindows.FileExists(strmailopslag & woord) = True
woord = woord & "DUBBEL"
Loop
' MsgBox "ik ga nu opslaan: " &
woord

olMailItem.Attachments.Item(iteller2).SaveAsFile strmailopslag & woord
End If
Next
End Select
olMailItem.Move olDeleteFolder
iaantalitems = iaantalitems + 1
End If
End If
If bGevonden = False Then
iteller = iteller + 1
End If
inttotteller = inttotteller + 1
Loop
' MsgBox " Gereed"
End Function

Regards
Marco

You're declaring myInboxMailItem as a Redemption.MailItem, when in your code context, it should be declared as Object.

Is this supposed to be Outlook VBA code? If so, this statement

Set olApplication = CreateObject("Outlook.Application")

should be replaced with

Set olApplication = Application

to use the intrinsic Outlook.Application object that VBA supports and thus avoid security prompts in Outlook 2003 or 2007.

I see no actual use of Redemption techniques in your code at all, except in this statement

woord = olMailItem.Fields(PR_SUBJECT)

which can be replaced with

woord = olMailItem.Subject

because the Subject property can be accessed directly in all Outlook items.
--
Sue Mosher, Outlook MVP
Author of Microsoft Outlook 2007 Programming:
Jumpstart for Power Users and Administrators
http://www.outlookcode.com/article.aspx?id=54


"vonClausowitz" wrote in message ...
Hi All,

I use a code to check for new emails coming in and move them to a
designated location.
The code for the Redemption that I use doesn't work:
In RETRIEVE_MAIL it fails at:
Set olMailItem = olInbox.Items.Item(iteller) 'TYPE MISMATCH


Dim WithEvents myInboxMailItem As Outlook.Items

Private Sub myInboxMailItem_ItemAdd(ByVal Item As Object)
Call RETRIEVE_MAIL
End Sub

Private Sub Initialize_Handler()

Dim fldInbox As Outlook.MAPIFolder
Dim gnspNameSpace As Outlook.NameSpace

Set gnspNameSpace = Outlook.GetNamespace("MAPI") 'Outlook Object
Set fldInbox = gnspNameSpace.Folders("Mailbox SB").Folders("Postvak
IN")
Set myInboxMailItem = fldInbox.Items

End Sub

Private Sub Application_Startup()
Call Initialize_Handler
End Sub


Public Function RETRIEVE_MAIL()

Dim olApplication As Outlook.Application
Dim oNamespace As Object
Dim olInbox As Outlook.MAPIFolder
Dim olDeleteFolder As Outlook.MAPIFolder
Dim olMailItem As Redemption.SafeMailItem
'Outlook.MailItem
Dim olMailItemBody As String
Dim fsoWindows As FileSystemObject
Set fsoWindows = CreateObject("scripting.filesystemobject")
Dim bGevonden As Boolean
Dim slijst As String
Dim Gwerkdir As String
Dim iteller As Integer
Dim iteller1 As Integer
Dim iteller2 As Integer
Dim inttotteller As Integer
Dim woord As String
Dim iaantalitems As Integer
Dim strmailopslag As String

strmailopslag = "J:\BIN\TEMP
\" ' locatie waar de
mail opgeslagen wordt!!!!!!

Set olMailItem = CreateObject("Redemption.SafeMailItem")
Set olApplication = CreateObject("Outlook.Application")
Set oNamespace = olApplication.GetNamespace("MAPI")
Set olInbox = oNamespace.Folders("Mailbox SB").Folders("Postvak IN")
Set olDeleteFolder = oNamespace.Folders("Mailbox
SB").Folders("Verwijderde items").Folders("OUD")
Set fsoWindows = CreateObject("Scripting.FileSystemObject")
iaantalitems = 0
iteller = 1
iteller2 = 0
bGevonden = False
woord = ""
Do While iteller = olInbox.Items.Count
Set olMailItem = olInbox.Items.Item(iteller) 'TYPE MISMATCH
bGevonden = False
If TypeName(olMailItem) = "MailItem" Then
If olMailItem.SenderName = "KD" Or olMailItem.SenderName =
"HN" Or olMailItem.SenderName = "NI" Or olMailItem.SenderName = "KB"
Then
bGevonden = True
Select Case olMailItem.Attachments.Count
Case 0 ' er is dus geen attachments!!
olMailItemBody = olMailItem.Body
woord = olMailItem.Fields(PR_SUBJECT)
'woord = checkfile(woord)
olMailItem.SaveAs strmailopslag & woord &
".txt"
Case Else ' er zijn wel attachments!!
For iteller2 = 1 To
olMailItem.Attachments.Count
woord =
olMailItem.Attachments.Item(iteller2).DisplayName
' in de opmaak van de TK bestanden
bevindt zich een Paintbrush Picture, deze willen we niet hebben...
If InStr(UCase(woord), "PAINTBRUSH") =
0 Then
' we moeten eerst nog even
controleren of er al geen dubbele bestanden in de CIU staan.
' alle "eventuele" dubbele
bestanden worden nu met dubbel aangeduid.
Do While
fsoWindows.FileExists(strmailopslag & woord) = True
woord = woord & "DUBBEL"
Loop
' MsgBox "ik ga nu opslaan: " &
woord

olMailItem.Attachments.Item(iteller2).SaveAsFile strmailopslag & woord
End If
Next
End Select
olMailItem.Move olDeleteFolder
iaantalitems = iaantalitems + 1
End If
End If
If bGevonden = False Then
iteller = iteller + 1
End If
inttotteller = inttotteller + 1
Loop
' MsgBox " Gereed"
End Function

Regards
Marco

On 13 jun, 14:21, "Sue Mosher [MVP-Outlook]"
wrote:
You're declaring myInboxMailItem as a Redemption.MailItem, when in your code context, it should be declared as Object.

Is this supposed to be Outlook VBA code? If so, this statement

* * Set olApplication = CreateObject("Outlook.Application")

should be replaced with

* * Set olApplication = Application

to use the intrinsic Outlook.Application object that VBA supports and thus avoid security prompts in Outlook 2003 or 2007.

I see no actual use of Redemption techniques in your code at all, except in this statement

* * woord = olMailItem.Fields(PR_SUBJECT)

which can be replaced with

* * woord = olMailItem.Subject

because the Subject property can be accessed directly in all Outlook items..
--
Sue Mosher, Outlook MVP
* *Author of Microsoft Outlook 2007 Programming:
* * *Jumpstart for Power Users and Administrators
* *http://www.outlookcode.com/article.aspx?id=54



"vonClausowitz" wrote in ...
Hi All,

I use a code to check for new emails coming in and move them to a
designated location.
The code for the Redemption that I use doesn't work:
In RETRIEVE_MAIL it fails at:
Set olMailItem = olInbox.Items.Item(iteller) * 'TYPE MISMATCH

Dim WithEvents myInboxMailItem As Outlook.Items

Private Sub myInboxMailItem_ItemAdd(ByVal Item As Object)
* *Call RETRIEVE_MAIL
End Sub

Private Sub Initialize_Handler()

Dim fldInbox As Outlook.MAPIFolder
Dim gnspNameSpace As Outlook.NameSpace

Set gnspNameSpace = Outlook.GetNamespace("MAPI") 'Outlook Object
Set fldInbox = gnspNameSpace.Folders("Mailbox SB").Folders("Postvak
IN")
Set myInboxMailItem = fldInbox.Items

End Sub

Private Sub Application_Startup()
* *Call Initialize_Handler
End Sub

Public Function RETRIEVE_MAIL()

Dim olApplication As Outlook.Application
Dim oNamespace As Object
Dim olInbox As Outlook.MAPIFolder
Dim olDeleteFolder As Outlook.MAPIFolder
Dim olMailItem As Redemption.SafeMailItem
'Outlook.MailItem
Dim olMailItemBody As String
Dim fsoWindows As FileSystemObject
Set fsoWindows = CreateObject("scripting.filesystemobject")
Dim bGevonden As Boolean
Dim slijst As String
Dim Gwerkdir As String
Dim iteller As Integer
Dim iteller1 As Integer
Dim iteller2 As Integer
Dim inttotteller As Integer
Dim woord As String
Dim iaantalitems As Integer
Dim strmailopslag As String

strmailopslag = "J:\BIN\TEMP
\" * * * * * * * * * * * * * * * * * * * * * * * * *' locatie waar de
mail opgeslagen wordt!!!!!!

Set olMailItem = CreateObject("Redemption.SafeMailItem")
Set olApplication = CreateObject("Outlook.Application")
Set oNamespace = olApplication.GetNamespace("MAPI")
Set olInbox = oNamespace.Folders("Mailbox SB").Folders("Postvak IN")
Set olDeleteFolder = oNamespace.Folders("Mailbox
SB").Folders("Verwijderde items").Folders("OUD")
Set fsoWindows = CreateObject("Scripting.FileSystemObject")
* *iaantalitems = 0
* *iteller = 1
* *iteller2 = 0
* *bGevonden = False
* *woord = ""
* *Do While iteller = olInbox.Items.Count
* * * Set olMailItem = olInbox.Items.Item(iteller) * 'TYPE MISMATCH
* * * bGevonden = False
* * * *If TypeName(olMailItem) = "MailItem" Then
* * * * * *If olMailItem.SenderName = "KD" Or olMailItem.SenderName =
"HN" Or olMailItem.SenderName = "NI" Or olMailItem.SenderName = "KB"
Then
* * * * * * * * * *bGevonden = True
* * * * * * * * * *Select Case olMailItem.Attachments.Count
* * * * * * * * * * * *Case 0 * * *' er is dus geen attachments!!
* * * * * * * * * * * * * *olMailItemBody = olMailItem.Body
* * * * * * * * * * * * * *woord = olMailItem.Fields(PR_SUBJECT)
* * * * * * * * * * * * * * * * * *'woord = checkfile(woord)
* * * * * * * * * * * * * *olMailItem.SaveAs strmailopslag & woord &
".txt"
* * * * * * * * * * * *Case Else ' er zijn wel attachments!!
* * * * * * * * * * * * * *For iteller2 = 1 To
olMailItem.Attachments.Count
* * * * * * * * * * * * * *woord =
olMailItem.Attachments.Item(iteller2).DisplayName
* * * * * * * * * * * * * * * * * *' in de opmaak van de TK bestanden
bevindt zich een Paintbrush Picture, deze willen we niet hebben...
* * * * * * * * * * * * * * * *If InStr(UCase(woord), "PAINTBRUSH") =
0 Then
* * * * * * * * * * * * * * * * * *' we moeten eerst nog even
controleren of er al geen dubbele bestanden in de CIU staan.
* * * * * * * * * * * * * * * * * *' alle "eventuele" dubbele
bestanden worden nu met dubbel aangeduid.
* * * * * * * * * * * * * * * * * * * *Do While
fsoWindows.FileExists(strmailopslag & woord) = True
* * * * * * * * * * * * * * * * * * * * * woord = woord & "DUBBEL"
* * * * * * * * * * * * * * * * * * * *Loop
* * * * * * * * * * * * * * * * * ' MsgBox "ik ga nu opslaan: " &
woord

olMailItem.Attachments.Item(iteller2).SaveAsFile strmailopslag & woord
* * * * * * * * * * * * * * * *End If
* * * * * * * * * * * * * *Next
* * * * * * * * * *End Select
* * * * * * * * * *olMailItem.Move olDeleteFolder
* * * * * * * * * *iaantalitems = iaantalitems + 1
* * * * * *End If
* * * *End If
* * * *If bGevonden = False Then
* * * * *iteller = iteller + 1
* * * *End If
* * * *inttotteller = inttotteller + 1
* *Loop
* *' MsgBox " Gereed"
End Function

Regards
Marco- Tekst uit oorspronkelijk bericht niet weergeven -

- Tekst uit oorspronkelijk bericht weergeven -

Sue,

this is indeed Outlook code.
The fact that I'm using redemption is because I have two emailboxes.
When email comes in to my own emailbox there is no problem but I also
use a common emailbox.
When emails arrive to this emailbox I get a popupbox all the time
asking me if I will allow the action.
That's why I use redemption.

Marco

But you're not actually using Redemption in your code. The cause of the message prompts is that you're not using the intrinsic Application object.

--
Sue Mosher, Outlook MVP
Author of Microsoft Outlook 2007 Programming:
Jumpstart for Power Users and Administrators
http://www.outlookcode.com/article.aspx?id=54


"vonClausowitz" wrote in message ...
On 13 jun, 14:21, "Sue Mosher [MVP-Outlook]"
wrote:
You're declaring myInboxMailItem as a Redemption.MailItem, when in your code context, it should be declared as Object.

Is this supposed to be Outlook VBA code? If so, this statement

Set olApplication = CreateObject("Outlook.Application")

should be replaced with

Set olApplication = Application

to use the intrinsic Outlook.Application object that VBA supports and thus avoid security prompts in Outlook 2003 or 2007.

I see no actual use of Redemption techniques in your code at all, except in this statement

woord = olMailItem.Fields(PR_SUBJECT)

which can be replaced with

woord = olMailItem.Subject

because the Subject property can be accessed directly in all Outlook items.
--
Sue Mosher, Outlook MVP
Author of Microsoft Outlook 2007 Programming:
Jumpstart for Power Users and Administrators
http://www.outlookcode.com/article.aspx?id=54



"vonClausowitz" wrote in ...
Hi All,

I use a code to check for new emails coming in and move them to a
designated location.
The code for the Redemption that I use doesn't work:
In RETRIEVE_MAIL it fails at:
Set olMailItem = olInbox.Items.Item(iteller) 'TYPE MISMATCH

Dim WithEvents myInboxMailItem As Outlook.Items

Private Sub myInboxMailItem_ItemAdd(ByVal Item As Object)
Call RETRIEVE_MAIL
End Sub

Private Sub Initialize_Handler()

Dim fldInbox As Outlook.MAPIFolder
Dim gnspNameSpace As Outlook.NameSpace

Set gnspNameSpace = Outlook.GetNamespace("MAPI") 'Outlook Object
Set fldInbox = gnspNameSpace.Folders("Mailbox SB").Folders("Postvak
IN")
Set myInboxMailItem = fldInbox.Items

End Sub

Private Sub Application_Startup()
Call Initialize_Handler
End Sub

Public Function RETRIEVE_MAIL()

Dim olApplication As Outlook.Application
Dim oNamespace As Object
Dim olInbox As Outlook.MAPIFolder
Dim olDeleteFolder As Outlook.MAPIFolder
Dim olMailItem As Redemption.SafeMailItem
'Outlook.MailItem
Dim olMailItemBody As String
Dim fsoWindows As FileSystemObject
Set fsoWindows = CreateObject("scripting.filesystemobject")
Dim bGevonden As Boolean
Dim slijst As String
Dim Gwerkdir As String
Dim iteller As Integer
Dim iteller1 As Integer
Dim iteller2 As Integer
Dim inttotteller As Integer
Dim woord As String
Dim iaantalitems As Integer
Dim strmailopslag As String

strmailopslag = "J:\BIN\TEMP
\" ' locatie waar de
mail opgeslagen wordt!!!!!!

Set olMailItem = CreateObject("Redemption.SafeMailItem")
Set olApplication = CreateObject("Outlook.Application")
Set oNamespace = olApplication.GetNamespace("MAPI")
Set olInbox = oNamespace.Folders("Mailbox SB").Folders("Postvak IN")
Set olDeleteFolder = oNamespace.Folders("Mailbox
SB").Folders("Verwijderde items").Folders("OUD")
Set fsoWindows = CreateObject("Scripting.FileSystemObject")
iaantalitems = 0
iteller = 1
iteller2 = 0
bGevonden = False
woord = ""
Do While iteller = olInbox.Items.Count
Set olMailItem = olInbox.Items.Item(iteller) 'TYPE MISMATCH
bGevonden = False
If TypeName(olMailItem) = "MailItem" Then
If olMailItem.SenderName = "KD" Or olMailItem.SenderName =
"HN" Or olMailItem.SenderName = "NI" Or olMailItem.SenderName = "KB"
Then
bGevonden = True
Select Case olMailItem.Attachments.Count
Case 0 ' er is dus geen attachments!!
olMailItemBody = olMailItem.Body
woord = olMailItem.Fields(PR_SUBJECT)
'woord = checkfile(woord)
olMailItem.SaveAs strmailopslag & woord &
".txt"
Case Else ' er zijn wel attachments!!
For iteller2 = 1 To
olMailItem.Attachments.Count
woord =
olMailItem.Attachments.Item(iteller2).DisplayName
' in de opmaak van de TK bestanden
bevindt zich een Paintbrush Picture, deze willen we niet hebben...
If InStr(UCase(woord), "PAINTBRUSH") =
0 Then
' we moeten eerst nog even
controleren of er al geen dubbele bestanden in de CIU staan.
' alle "eventuele" dubbele
bestanden worden nu met dubbel aangeduid.
Do While
fsoWindows.FileExists(strmailopslag & woord) = True
woord = woord & "DUBBEL"
Loop
' MsgBox "ik ga nu opslaan: " &
woord

olMailItem.Attachments.Item(iteller2).SaveAsFile strmailopslag & woord
End If
Next
End Select
olMailItem.Move olDeleteFolder
iaantalitems = iaantalitems + 1
End If
End If
If bGevonden = False Then
iteller = iteller + 1
End If
inttotteller = inttotteller + 1
Loop
' MsgBox " Gereed"
End Function

Regards
Marco- Tekst uit oorspronkelijk bericht niet weergeven -

- Tekst uit oorspronkelijk bericht weergeven -

Sue,

this is indeed Outlook code.
The fact that I'm using redemption is because I have two emailboxes.
When email comes in to my own emailbox there is no problem but I also
use a common emailbox.
When emails arrive to this emailbox I get a popupbox all the time
asking me if I will allow the action.
That's why I use redemption.

Marco

On 13 jun, 15:15, "Sue Mosher [MVP-Outlook]"
wrote:
But you're not actually using Redemption in your code. The cause of the message prompts is that you're not using the intrinsic Application object.

--
Sue Mosher, Outlook MVP
* *Author of Microsoft Outlook 2007 Programming:
* * *Jumpstart for Power Users and Administrators
* *http://www.outlookcode.com/article.aspx?id=54

"vonClausowitz" wrote in ...

On 13 jun, 14:21, "Sue Mosher [MVP-Outlook]"
wrote:





You're declaring myInboxMailItem as a Redemption.MailItem, when in your code context, it should be declared as Object.

Is this supposed to be Outlook VBA code? If so, this statement

Set olApplication = CreateObject("Outlook.Application")

should be replaced with

Set olApplication = Application

to use the intrinsic Outlook.Application object that VBA supports and thus avoid security prompts in Outlook 2003 or 2007.

I see no actual use of Redemption techniques in your code at all, except in this statement

woord = olMailItem.Fields(PR_SUBJECT)

which can be replaced with

woord = olMailItem.Subject

because the Subject property can be accessed directly in all Outlook items.
--
Sue Mosher, Outlook MVP
Author of Microsoft Outlook 2007 Programming:
Jumpstart for Power Users and Administrators
http://www.outlookcode.com/article.aspx?id=54

"vonClausowitz" wrote in ...
Hi All,

I use a code to check for new emails coming in and move them to a
designated location.
The code for the Redemption that I use doesn't work:
In RETRIEVE_MAIL it fails at:
Set olMailItem = olInbox.Items.Item(iteller) 'TYPE MISMATCH

Dim WithEvents myInboxMailItem As Outlook.Items

Private Sub myInboxMailItem_ItemAdd(ByVal Item As Object)
Call RETRIEVE_MAIL
End Sub

Private Sub Initialize_Handler()

Dim fldInbox As Outlook.MAPIFolder
Dim gnspNameSpace As Outlook.NameSpace

Set gnspNameSpace = Outlook.GetNamespace("MAPI") 'Outlook Object
Set fldInbox = gnspNameSpace.Folders("Mailbox SB").Folders("Postvak
IN")
Set myInboxMailItem = fldInbox.Items

End Sub

Private Sub Application_Startup()
Call Initialize_Handler
End Sub

Public Function RETRIEVE_MAIL()

Dim olApplication As Outlook.Application
Dim oNamespace As Object
Dim olInbox As Outlook.MAPIFolder
Dim olDeleteFolder As Outlook.MAPIFolder
Dim olMailItem As Redemption.SafeMailItem
'Outlook.MailItem
Dim olMailItemBody As String
Dim fsoWindows As FileSystemObject
Set fsoWindows = CreateObject("scripting.filesystemobject")
Dim bGevonden As Boolean
Dim slijst As String
Dim Gwerkdir As String
Dim iteller As Integer
Dim iteller1 As Integer
Dim iteller2 As Integer
Dim inttotteller As Integer
Dim woord As String
Dim iaantalitems As Integer
Dim strmailopslag As String

strmailopslag = "J:\BIN\TEMP
\" ' locatie waar de
mail opgeslagen wordt!!!!!!

Set olMailItem = CreateObject("Redemption.SafeMailItem")
Set olApplication = CreateObject("Outlook.Application")
Set oNamespace = olApplication.GetNamespace("MAPI")
Set olInbox = oNamespace.Folders("Mailbox SB").Folders("Postvak IN")
Set olDeleteFolder = oNamespace.Folders("Mailbox
SB").Folders("Verwijderde items").Folders("OUD")
Set fsoWindows = CreateObject("Scripting.FileSystemObject")
iaantalitems = 0
iteller = 1
iteller2 = 0
bGevonden = False
woord = ""
Do While iteller = olInbox.Items.Count
Set olMailItem = olInbox.Items.Item(iteller) 'TYPE MISMATCH
bGevonden = False
If TypeName(olMailItem) = "MailItem" Then
If olMailItem.SenderName = "KD" Or olMailItem.SenderName =
"HN" Or olMailItem.SenderName = "NI" Or olMailItem.SenderName = "KB"
Then
bGevonden = True
Select Case olMailItem.Attachments.Count
Case 0 ' er is dus geen attachments!!
olMailItemBody = olMailItem.Body
woord = olMailItem.Fields(PR_SUBJECT)
'woord = checkfile(woord)
olMailItem.SaveAs strmailopslag & woord &
".txt"
Case Else ' er zijn wel attachments!!
For iteller2 = 1 To
olMailItem.Attachments.Count
woord =
olMailItem.Attachments.Item(iteller2).DisplayName
' in de opmaak van de TK bestanden
bevindt zich een Paintbrush Picture, deze willen we niet hebben...
If InStr(UCase(woord), "PAINTBRUSH") =
0 Then
' we moeten eerst nog even
controleren of er al geen dubbele bestanden in de CIU staan.
' alle "eventuele" dubbele
bestanden worden nu met dubbel aangeduid.
Do While
fsoWindows.FileExists(strmailopslag & woord) = True
woord = woord & "DUBBEL"
Loop
' MsgBox "ik ga nu opslaan: " &
woord

olMailItem.Attachments.Item(iteller2).SaveAsFile strmailopslag & woord
End If
Next
End Select
olMailItem.Move olDeleteFolder
iaantalitems = iaantalitems + 1
End If
End If
If bGevonden = False Then
iteller = iteller + 1
End If
inttotteller = inttotteller + 1
Loop
' MsgBox " Gereed"
End Function

Regards
Marco- Tekst uit oorspronkelijk bericht niet weergeven -

- Tekst uit oorspronkelijk bericht weergeven -

Sue,

this is indeed Outlook code.
The fact that I'm using redemption is because I have two emailboxes.
When email comes in to my own emailbox there is no problem but I also
use a common emailbox.
When emails arrive to this emailbox I get a popupbox all the time
asking me if I will allow the action.
That's why I use redemption.

Marco- Tekst uit oorspronkelijk bericht niet weergeven -

- Tekst uit oorspronkelijk bericht weergeven -

So if I remove all the "Outlook." in front of my dim statements it
would work?
And then I won't need redemption?

Marco

So if I remove all the "Outlook." in front of my dim statements it would work?

No, you need to follow the very specific instructions I gave in my first response for changing two statements in your code.

--
Sue Mosher, Outlook MVP
Author of Microsoft Outlook 2007 Programming:
Jumpstart for Power Users and Administrators
http://www.outlookcode.com/article.aspx?id=54


"vonClausowitz" wrote in message ...
On 13 jun, 15:15, "Sue Mosher [MVP-Outlook]"
wrote:
But you're not actually using Redemption in your code. The cause of the message prompts is that you're not using the intrinsic Application object.

"vonClausowitz" wrote in ...

On 13 jun, 14:21, "Sue Mosher [MVP-Outlook]"
wrote:

You're declaring myInboxMailItem as a Redemption.MailItem, when in your code context, it should be declared as Object.

Is this supposed to be Outlook VBA code? If so, this statement

Set olApplication = CreateObject("Outlook.Application")

should be replaced with

Set olApplication = Application

to use the intrinsic Outlook.Application object that VBA supports and thus avoid security prompts in Outlook 2003 or 2007.

I see no actual use of Redemption techniques in your code at all, except in this statement

woord = olMailItem.Fields(PR_SUBJECT)

which can be replaced with

woord = olMailItem.Subject

because the Subject property can be accessed directly in all Outlook items.
--
Sue Mosher, Outlook MVP
Author of Microsoft Outlook 2007 Programming:
Jumpstart for Power Users and Administrators
http://www.outlookcode.com/article.aspx?id=54

"vonClausowitz" wrote in ...
Hi All,

I use a code to check for new emails coming in and move them to a
designated location.
The code for the Redemption that I use doesn't work:
In RETRIEVE_MAIL it fails at:
Set olMailItem = olInbox.Items.Item(iteller) 'TYPE MISMATCH

Dim WithEvents myInboxMailItem As Outlook.Items

Private Sub myInboxMailItem_ItemAdd(ByVal Item As Object)
Call RETRIEVE_MAIL
End Sub

Private Sub Initialize_Handler()

Dim fldInbox As Outlook.MAPIFolder
Dim gnspNameSpace As Outlook.NameSpace

Set gnspNameSpace = Outlook.GetNamespace("MAPI") 'Outlook Object
Set fldInbox = gnspNameSpace.Folders("Mailbox SB").Folders("Postvak
IN")
Set myInboxMailItem = fldInbox.Items

End Sub

Private Sub Application_Startup()
Call Initialize_Handler
End Sub

Public Function RETRIEVE_MAIL()

Dim olApplication As Outlook.Application
Dim oNamespace As Object
Dim olInbox As Outlook.MAPIFolder
Dim olDeleteFolder As Outlook.MAPIFolder
Dim olMailItem As Redemption.SafeMailItem
'Outlook.MailItem
Dim olMailItemBody As String
Dim fsoWindows As FileSystemObject
Set fsoWindows = CreateObject("scripting.filesystemobject")
Dim bGevonden As Boolean
Dim slijst As String
Dim Gwerkdir As String
Dim iteller As Integer
Dim iteller1 As Integer
Dim iteller2 As Integer
Dim inttotteller As Integer
Dim woord As String
Dim iaantalitems As Integer
Dim strmailopslag As String

strmailopslag = "J:\BIN\TEMP
\" ' locatie waar de
mail opgeslagen wordt!!!!!!

Set olMailItem = CreateObject("Redemption.SafeMailItem")
Set olApplication = CreateObject("Outlook.Application")
Set oNamespace = olApplication.GetNamespace("MAPI")
Set olInbox = oNamespace.Folders("Mailbox SB").Folders("Postvak IN")
Set olDeleteFolder = oNamespace.Folders("Mailbox
SB").Folders("Verwijderde items").Folders("OUD")
Set fsoWindows = CreateObject("Scripting.FileSystemObject")
iaantalitems = 0
iteller = 1
iteller2 = 0
bGevonden = False
woord = ""
Do While iteller = olInbox.Items.Count
Set olMailItem = olInbox.Items.Item(iteller) 'TYPE MISMATCH
bGevonden = False
If TypeName(olMailItem) = "MailItem" Then
If olMailItem.SenderName = "KD" Or olMailItem.SenderName =
"HN" Or olMailItem.SenderName = "NI" Or olMailItem.SenderName = "KB"
Then
bGevonden = True
Select Case olMailItem.Attachments.Count
Case 0 ' er is dus geen attachments!!
olMailItemBody = olMailItem.Body
woord = olMailItem.Fields(PR_SUBJECT)
'woord = checkfile(woord)
olMailItem.SaveAs strmailopslag & woord &
".txt"
Case Else ' er zijn wel attachments!!
For iteller2 = 1 To
olMailItem.Attachments.Count
woord =
olMailItem.Attachments.Item(iteller2).DisplayName
' in de opmaak van de TK bestanden
bevindt zich een Paintbrush Picture, deze willen we niet hebben...
If InStr(UCase(woord), "PAINTBRUSH") =
0 Then
' we moeten eerst nog even
controleren of er al geen dubbele bestanden in de CIU staan.
' alle "eventuele" dubbele
bestanden worden nu met dubbel aangeduid.
Do While
fsoWindows.FileExists(strmailopslag & woord) = True
woord = woord & "DUBBEL"
Loop
' MsgBox "ik ga nu opslaan: " &
woord

olMailItem.Attachments.Item(iteller2).SaveAsFile strmailopslag & woord
End If
Next
End Select
olMailItem.Move olDeleteFolder
iaantalitems = iaantalitems + 1
End If
End If
If bGevonden = False Then
iteller = iteller + 1
End If
inttotteller = inttotteller + 1
Loop
' MsgBox " Gereed"
End Function

Regards
Marco- Tekst uit oorspronkelijk bericht niet weergeven -

- Tekst uit oorspronkelijk bericht weergeven -

Sue,

this is indeed Outlook code.
The fact that I'm using redemption is because I have two emailboxes.
When email comes in to my own emailbox there is no problem but I also
use a common emailbox.
When emails arrive to this emailbox I get a popupbox all the time
asking me if I will allow the action.
That's why I use redemption.

Marco- Tekst uit oorspronkelijk bericht niet weergeven -

- Tekst uit oorspronkelijk bericht weergeven -

So if I remove all the "Outlook." in front of my dim statements it
would work?
And then I won't need redemption?

Marco

How exactly did you declare the olMailItem variable?

--
Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool
-
"vonClausowitz" wrote in message
...
Hi All,

I use a code to check for new emails coming in and move them to a
designated location.
The code for the Redemption that I use doesn't work:
In RETRIEVE_MAIL it fails at:
Set olMailItem = olInbox.Items.Item(iteller) 'TYPE MISMATCH


Dim WithEvents myInboxMailItem As Outlook.Items

Private Sub myInboxMailItem_ItemAdd(ByVal Item As Object)
Call RETRIEVE_MAIL
End Sub

Private Sub Initialize_Handler()

Dim fldInbox As Outlook.MAPIFolder
Dim gnspNameSpace As Outlook.NameSpace

Set gnspNameSpace = Outlook.GetNamespace("MAPI") 'Outlook Object
Set fldInbox = gnspNameSpace.Folders("Mailbox SB").Folders("Postvak
IN")
Set myInboxMailItem = fldInbox.Items

End Sub

Private Sub Application_Startup()
Call Initialize_Handler
End Sub


Public Function RETRIEVE_MAIL()

Dim olApplication As Outlook.Application
Dim oNamespace As Object
Dim olInbox As Outlook.MAPIFolder
Dim olDeleteFolder As Outlook.MAPIFolder
Dim olMailItem As Redemption.SafeMailItem
'Outlook.MailItem
Dim olMailItemBody As String
Dim fsoWindows As FileSystemObject
Set fsoWindows = CreateObject("scripting.filesystemobject")
Dim bGevonden As Boolean
Dim slijst As String
Dim Gwerkdir As String
Dim iteller As Integer
Dim iteller1 As Integer
Dim iteller2 As Integer
Dim inttotteller As Integer
Dim woord As String
Dim iaantalitems As Integer
Dim strmailopslag As String

strmailopslag = "J:\BIN\TEMP
\" ' locatie waar de
mail opgeslagen wordt!!!!!!

Set olMailItem = CreateObject("Redemption.SafeMailItem")
Set olApplication = CreateObject("Outlook.Application")
Set oNamespace = olApplication.GetNamespace("MAPI")
Set olInbox = oNamespace.Folders("Mailbox SB").Folders("Postvak IN")
Set olDeleteFolder = oNamespace.Folders("Mailbox
SB").Folders("Verwijderde items").Folders("OUD")
Set fsoWindows = CreateObject("Scripting.FileSystemObject")
iaantalitems = 0
iteller = 1
iteller2 = 0
bGevonden = False
woord = ""
Do While iteller = olInbox.Items.Count
Set olMailItem = olInbox.Items.Item(iteller) 'TYPE MISMATCH
bGevonden = False
If TypeName(olMailItem) = "MailItem" Then
If olMailItem.SenderName = "KD" Or olMailItem.SenderName =
"HN" Or olMailItem.SenderName = "NI" Or olMailItem.SenderName = "KB"
Then
bGevonden = True
Select Case olMailItem.Attachments.Count
Case 0 ' er is dus geen attachments!!
olMailItemBody = olMailItem.Body
woord = olMailItem.Fields(PR_SUBJECT)
'woord = checkfile(woord)
olMailItem.SaveAs strmailopslag & woord &
".txt"
Case Else ' er zijn wel attachments!!
For iteller2 = 1 To
olMailItem.Attachments.Count
woord =
olMailItem.Attachments.Item(iteller2).DisplayName
' in de opmaak van de TK bestanden
bevindt zich een Paintbrush Picture, deze willen we niet hebben...
If InStr(UCase(woord), "PAINTBRUSH") =
0 Then
' we moeten eerst nog even
controleren of er al geen dubbele bestanden in de CIU staan.
' alle "eventuele" dubbele
bestanden worden nu met dubbel aangeduid.
Do While
fsoWindows.FileExists(strmailopslag & woord) = True
woord = woord & "DUBBEL"
Loop
' MsgBox "ik ga nu opslaan: " &
woord

olMailItem.Attachments.Item(iteller2).SaveAsFile strmailopslag & woord
End If
Next
End Select
olMailItem.Move olDeleteFolder
iaantalitems = iaantalitems + 1
End If
End If
If bGevonden = False Then
iteller = iteller + 1
End If
inttotteller = inttotteller + 1
Loop
' MsgBox " Gereed"
End Function

Regards
Marco

On 16 jun, 18:58, "Dmitry Streblechenko" wrote:
How exactly did you declare the olMailItem variable?

--
Dmitry Streblechenko (MVP)http://www.dimastr.com/
OutlookSpy *- Outlook, CDO
and MAPI Developer Tool
-"vonClausowitz" wrote in message

...



Hi All,

I use a code to check for new emails coming in and move them to a
designated location.
The code for the Redemption that I use doesn't work:
In RETRIEVE_MAIL it fails at:
Set olMailItem = olInbox.Items.Item(iteller) * 'TYPE MISMATCH

Dim WithEvents myInboxMailItem As Outlook.Items

Private Sub myInboxMailItem_ItemAdd(ByVal Item As Object)
* *Call RETRIEVE_MAIL
End Sub

Private Sub Initialize_Handler()

Dim fldInbox As Outlook.MAPIFolder
Dim gnspNameSpace As Outlook.NameSpace

Set gnspNameSpace = Outlook.GetNamespace("MAPI") 'Outlook Object
Set fldInbox = gnspNameSpace.Folders("Mailbox SB").Folders("Postvak
IN")
Set myInboxMailItem = fldInbox.Items

End Sub

Private Sub Application_Startup()
* *Call Initialize_Handler
End Sub

Public Function RETRIEVE_MAIL()

Dim olApplication As Outlook.Application
Dim oNamespace As Object
Dim olInbox As Outlook.MAPIFolder
Dim olDeleteFolder As Outlook.MAPIFolder
Dim olMailItem As Redemption.SafeMailItem
'Outlook.MailItem
Dim olMailItemBody As String
Dim fsoWindows As FileSystemObject
Set fsoWindows = CreateObject("scripting.filesystemobject")
Dim bGevonden As Boolean
Dim slijst As String
Dim Gwerkdir As String
Dim iteller As Integer
Dim iteller1 As Integer
Dim iteller2 As Integer
Dim inttotteller As Integer
Dim woord As String
Dim iaantalitems As Integer
Dim strmailopslag As String

strmailopslag = "J:\BIN\TEMP
\" * * * * * * * * * * * * * * * * * * * * * * * * *' locatie waar de
mail opgeslagen wordt!!!!!!

Set olMailItem = CreateObject("Redemption.SafeMailItem")
Set olApplication = CreateObject("Outlook.Application")
Set oNamespace = olApplication.GetNamespace("MAPI")
Set olInbox = oNamespace.Folders("Mailbox SB").Folders("Postvak IN")
Set olDeleteFolder = oNamespace.Folders("Mailbox
SB").Folders("Verwijderde items").Folders("OUD")
Set fsoWindows = CreateObject("Scripting.FileSystemObject")
* *iaantalitems = 0
* *iteller = 1
* *iteller2 = 0
* *bGevonden = False
* *woord = ""
* *Do While iteller = olInbox.Items.Count
* * * Set olMailItem = olInbox.Items.Item(iteller) * 'TYPE MISMATCH
* * * bGevonden = False
* * * *If TypeName(olMailItem) = "MailItem" Then
* * * * * *If olMailItem.SenderName = "KD" Or olMailItem.SenderName =
"HN" Or olMailItem.SenderName = "NI" Or olMailItem.SenderName = "KB"
Then
* * * * * * * * * *bGevonden = True
* * * * * * * * * *Select Case olMailItem.Attachments.Count
* * * * * * * * * * * *Case 0 * * *' er is dus geen attachments!!
* * * * * * * * * * * * * *olMailItemBody = olMailItem.Body
* * * * * * * * * * * * * *woord = olMailItem.Fields(PR_SUBJECT)
* * * * * * * * * * * * * * * * * *'woord = checkfile(woord)
* * * * * * * * * * * * * *olMailItem.SaveAs strmailopslag & woord &
".txt"
* * * * * * * * * * * *Case Else ' er zijn wel attachments!!
* * * * * * * * * * * * * *For iteller2 = 1 To
olMailItem.Attachments.Count
* * * * * * * * * * * * * *woord =
olMailItem.Attachments.Item(iteller2).DisplayName
* * * * * * * * * * * * * * * * * *' in de opmaak van de TK bestanden
bevindt zich een Paintbrush Picture, deze willen we niet hebben...
* * * * * * * * * * * * * * * *If InStr(UCase(woord), "PAINTBRUSH") =
0 Then
* * * * * * * * * * * * * * * * * *' we moeten eerst nog even
controleren of er al geen dubbele bestanden in de CIU staan.
* * * * * * * * * * * * * * * * * *' alle "eventuele" dubbele
bestanden worden nu met dubbel aangeduid.
* * * * * * * * * * * * * * * * * * * *Do While
fsoWindows.FileExists(strmailopslag & woord) = True
* * * * * * * * * * * * * * * * * * * * * woord = woord & "DUBBEL"
* * * * * * * * * * * * * * * * * * * *Loop
* * * * * * * * * * * * * * * * * ' MsgBox "ik ga nu opslaan: " &
woord

olMailItem.Attachments.Item(iteller2).SaveAsFile strmailopslag & woord
* * * * * * * * * * * * * * * *End If
* * * * * * * * * * * * * *Next
* * * * * * * * * *End Select
* * * * * * * * * *olMailItem.Move olDeleteFolder
* * * * * * * * * *iaantalitems = iaantalitems + 1
* * * * * *End If
* * * *End If
* * * *If bGevonden = False Then
* * * * *iteller = iteller + 1
* * * *End If
* * * *inttotteller = inttotteller + 1
* *Loop
* *' MsgBox " Gereed"
End Function

Regards
Marco- Tekst uit oorspronkelijk bericht niet weergeven -

- Tekst uit oorspronkelijk bericht weergeven -

I declared it as MailItem.

Marco

No, it looks like you declare it as Redemption.SafeMailItem:

Dim olMailItem As Redemption.SafeMailItem

Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool
-
"vonClausowitz" wrote in message
...
On 16 jun, 18:58, "Dmitry Streblechenko" wrote:
How exactly did you declare the olMailItem variable?

--
Dmitry Streblechenko (MVP)http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool
-"vonClausowitz" wrote in message

...



Hi All,

I use a code to check for new emails coming in and move them to a
designated location.
The code for the Redemption that I use doesn't work:
In RETRIEVE_MAIL it fails at:
Set olMailItem = olInbox.Items.Item(iteller) 'TYPE MISMATCH

Dim WithEvents myInboxMailItem As Outlook.Items

Private Sub myInboxMailItem_ItemAdd(ByVal Item As Object)
Call RETRIEVE_MAIL
End Sub

Private Sub Initialize_Handler()

Dim fldInbox As Outlook.MAPIFolder
Dim gnspNameSpace As Outlook.NameSpace

Set gnspNameSpace = Outlook.GetNamespace("MAPI") 'Outlook Object
Set fldInbox = gnspNameSpace.Folders("Mailbox SB").Folders("Postvak
IN")
Set myInboxMailItem = fldInbox.Items

End Sub

Private Sub Application_Startup()
Call Initialize_Handler
End Sub

Public Function RETRIEVE_MAIL()

Dim olApplication As Outlook.Application
Dim oNamespace As Object
Dim olInbox As Outlook.MAPIFolder
Dim olDeleteFolder As Outlook.MAPIFolder
Dim olMailItem As Redemption.SafeMailItem
'Outlook.MailItem
Dim olMailItemBody As String
Dim fsoWindows As FileSystemObject
Set fsoWindows = CreateObject("scripting.filesystemobject")
Dim bGevonden As Boolean
Dim slijst As String
Dim Gwerkdir As String
Dim iteller As Integer
Dim iteller1 As Integer
Dim iteller2 As Integer
Dim inttotteller As Integer
Dim woord As String
Dim iaantalitems As Integer
Dim strmailopslag As String

strmailopslag = "J:\BIN\TEMP
\" ' locatie waar de
mail opgeslagen wordt!!!!!!

Set olMailItem = CreateObject("Redemption.SafeMailItem")
Set olApplication = CreateObject("Outlook.Application")
Set oNamespace = olApplication.GetNamespace("MAPI")
Set olInbox = oNamespace.Folders("Mailbox SB").Folders("Postvak IN")
Set olDeleteFolder = oNamespace.Folders("Mailbox
SB").Folders("Verwijderde items").Folders("OUD")
Set fsoWindows = CreateObject("Scripting.FileSystemObject")
iaantalitems = 0
iteller = 1
iteller2 = 0
bGevonden = False
woord = ""
Do While iteller = olInbox.Items.Count
Set olMailItem = olInbox.Items.Item(iteller) 'TYPE MISMATCH
bGevonden = False
If TypeName(olMailItem) = "MailItem" Then
If olMailItem.SenderName = "KD" Or olMailItem.SenderName =
"HN" Or olMailItem.SenderName = "NI" Or olMailItem.SenderName = "KB"
Then
bGevonden = True
Select Case olMailItem.Attachments.Count
Case 0 ' er is dus geen attachments!!
olMailItemBody = olMailItem.Body
woord = olMailItem.Fields(PR_SUBJECT)
'woord = checkfile(woord)
olMailItem.SaveAs strmailopslag & woord &
".txt"
Case Else ' er zijn wel attachments!!
For iteller2 = 1 To
olMailItem.Attachments.Count
woord =
olMailItem.Attachments.Item(iteller2).DisplayName
' in de opmaak van de TK bestanden
bevindt zich een Paintbrush Picture, deze willen we niet hebben...
If InStr(UCase(woord), "PAINTBRUSH") =
0 Then
' we moeten eerst nog even
controleren of er al geen dubbele bestanden in de CIU staan.
' alle "eventuele" dubbele
bestanden worden nu met dubbel aangeduid.
Do While
fsoWindows.FileExists(strmailopslag & woord) = True
woord = woord & "DUBBEL"
Loop
' MsgBox "ik ga nu opslaan: " &
woord

olMailItem.Attachments.Item(iteller2).SaveAsFile strmailopslag & woord
End If
Next
End Select
olMailItem.Move olDeleteFolder
iaantalitems = iaantalitems + 1
End If
End If
If bGevonden = False Then
iteller = iteller + 1
End If
inttotteller = inttotteller + 1
Loop
' MsgBox " Gereed"
End Function

Regards
Marco- Tekst uit oorspronkelijk bericht niet weergeven -

- Tekst uit oorspronkelijk bericht weergeven -

I declared it as MailItem.

Marco