Re: redemption code doesn't work

On 13 jun, 14:21, "Sue Mosher [MVP-Outlook]" <sue...@xxxxxxxxxxxxxxx>
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" <vonclausow...@xxxxxxxxx> wrote in messagenews:e0de704b-d432-4f17-9869-ea126a1f1cc0@xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
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
.

Relevant Pages

  • Re: Need help with looping through records to email report
    ... Dim rst As DAO.Recordset ... Dim strEmail As String, strSubject As String, strMsgBody As String ... 'Insert inline error handling to handle a cancelled report ...     Dim dbs As DAO.Database ...
    (microsoft.public.access.forms)
  • Re: Excel Chart Macro Issue
    ... If the issue is string length, why would forming a large string at the end ... Sometimes this means setting up a summary range that the chart uses. ... Dim rDataX As Range ...   Dim wsData As Worksheet ...
    (microsoft.public.excel.programming)
  • Re: Mail Macro
    ... Dim sh As Worksheet ... Dim TempFilePath As String ... Dim SourceWB As Workbook ...     Dim sh As Worksheet ...
    (microsoft.public.excel.programming)
  • Re: Dynsmic Charts
    ... construct one of those ranges, if you don't know it ahead of time, you need ...   Dim rDataX As Range ... period on a chart. ...
    (microsoft.public.excel.programming)
  • Re: Send Word Data to Excel
    ... Dim vConnection As New ADODB.Connection ... Dim oPath As String ... Dim FileArrayAs String ...    Exit Sub ...
    (microsoft.public.word.vba.general)