Re: [AccessDevelopers] Re: Finding outlook email items and selectively forwarding them

 

OK.  Here is the code detail:

Private Sub cmdScan_Click()
' On Error GoTo Err_cmdScan_Click

    Dim stDocName As String
    Dim stLinkCriteria As String
    Dim intIndx2Limit As Integer
    Dim rst
    Dim intCount As Integer
   
Clear_List2
ClearTable

intIndx2 = 0
intitem = 0

'            up to the first 3000 items in the inbox are loaded into an array (arritems)

'            This section looks for inbox emails (in arrItems) having subject "Undeliverable..." or "Failure notice..."

'

'            If so, it saves the array index into arrIndx (thus building a list of pointers to the items in arritems desired to be forwarded

'

    While intitem < intIndx
        If Not Len(arrItems(intitem, 0)) > 0 Then GoTo SkipAdd
        If Left(arrItems(intitem, 0), 23) = "Undeliverable: Invoice " Or _
            Left(arrItems(intitem, 0), 15) = "failure notice " Then
                arrIndx(intIndx2) = intitem
                intIndx2 = intIndx2 + 1
                List2.AddItem (arrItems(intitem, 0) & ";" & Right(arrItems(intitem, 1), 40) & ";" & arrItems(intitem, 2))
        End If
SkipAdd:
    intitem = intitem + 1
    Wend
'   
'           Put the desired items from arrItems in table tblInvoiceFind by parsing the subject line to get the invoice#

'
    If Not intIndx2 > 0 Then GoTo Exit_cmdScan_Click
    intIndx2Limit = intIndx2
    intIndx2 = 0
InsertLoop:
    If Left(arrItems(arrIndx(intIndx2), 0), 14) = "Undeliverable:" Then
        strSQL = "Insert into tblinvoicefind (Invoice, InvObjID, emailsubject) "
        strSQL = strSQL & "values ('" & Mid(arrItems(arrIndx(intIndx2), 0), 24, 11) & "', '" & arrItems(arrIndx(intIndx2), 1) & "', '"
        strSQL = strSQL & arrItems(arrIndx(intIndx2), 0) & "')"
'        MsgBox strSQL
'        arrInvoice(intIndx2) = Mid(arrItems(arrIndx(intIndx2), 0), 24, 11)
    ElseIf Left(arrItems(arrIndx(intIndx2), 0), 15) = "failure notice " Then
'        strSQL = "Insert into tblinvoicefind (Invoice, InvObjID) values (" & "'" & Mid(arrItems(arrIndx(intIndx2), 0), 16, 11) & "', '" & arrItems(arrIndx(intIndx2), 0) & "')"
        strSQL = "Insert into tblinvoicefind (Invoice, InvObjID, emailsubject) "
        strSQL = strSQL & "values ('" & Mid(arrItems(arrIndx(intIndx2), 0), 16, 11) & "', '" & arrItems(arrIndx(intIndx2), 1) & "', '"
        strSQL = strSQL & arrItems(arrIndx(intIndx2), 0) & "')"
'        arrInvoice(intIndx2) = Mid(arrItems(arrIndx(intIndx2), 0), 16, 11)
    End If

'

    DoCmd.RunSQL strSQL
    intIndx2 = intIndx2 + 1
    If intIndx2Limit > intIndx2 Then GoTo InsertLoop
   

'        Find the Team for the returned email

'
'    stDocName = "Form1 Invoices"
'    DoCmd.OpenForm stDocName, , , stLinkCriteria
    stDocName = "FindInvoiceTeamEmail"
    DoCmd.OpenQuery stDocName, acNormal, acEdit

'
'   Loop thru and forward the proper items
'
'    strSQL = "select invoice, teamid, teamemail from Invoices2email"
    Set rst = CurrentDb.OpenRecordset("tblinvoicefind")
    rst.MoveLast
    intCount = rst.RecordCount
    rst.MoveFirst
    intIndx2 = 1
ProcessLoop:
'        Set the parameters

    SpecObjItem = rst.Fields(4)
'    MsgBox SpecObjItem
    SpecObjTarget = rst.Fields(2)
'    MsgBox SpecObjTarget
    SpecObjID = rst.Fields(3)

'        Forward the email
    GetEmailSpecificsFromOutlook
    intIndx2 = intIndx2 + 1
    If intCount >= intIndx2 Then GoTo ProcessLoop
    MsgBox "emails sent"
Exit_cmdScan_Click:
    Exit Sub

Err_cmdScan_Click:
    MsgBox Err.Description
    Resume Exit_cmdScan_Click
End Sub

 

'

'        This is the code that is not working

'

Public Sub GetEmailSpecificsFromOutlook()
Dim olapp As Object 'Outlook Application
Dim nms As Object 'MAPI NameSpace in Outlook
Dim olSession As Object ' Outlook session
Dim olEmailFolder As Object 'Inbox, can be any other folder etc.
Dim objItem As Outlook.MailItem 'A mail item.
Dim objItem2 As Object 'A mail item.
Dim myInspector As Outlook.Inspector
Dim mai As MailItem
'

'        Set values

'

Set olapp = CreateObject("Outlook.Application")
Set nms = olapp.GetNamespace("MAPI")
Set olSession = olapp.Session
Set olEmailFolder = nms.GetDefaultFolder(6) '6 = Default Inbox or the constant olFolderInbox
Set objItem2 = olSession.GetItemFromID(SpecObjID)
'Set objItem2 = SpecObjID
Set myInspector = olapp.ActiveInspector
'

'        This is where it fails - it does not recognize the item as a mail item

'

If objItem2.Class = olMail Then
    Set objItem = objItem2
    objItem.Forward
    objItem.To = "mwolfstone@brighton.com"
    objItem.Send
End If
Set olEmailFolder = Nothing
Set olSession = Nothing
Set olapp = Nothing
   

---

From: GiorgioR <giorgio_rovelli@virgilio.it>
To: AccessDevelopers@yahoogroups.com
Sent: Tue, July 5, 2011 4:15:56 PM
Subject: [AccessDevelopers] Re: Finding outlook email items and selectively forwarding them

 

Alright Mike, I stand corrected, it eventually gets out of the loop but
then, right out of the loop, it encounters the following:
If Not intIndx2 > 0 Then GoTo Exit_cmdScan_Click
and it exits the sub without ever running the
GetEmailSpecificsFromOutlook sub.

"it fails the IF check for a mail item and doesn't email anything."
Which one is the IF check you mean?
Giorgio

--- In AccessDevelopers@yahoogroups.com, Mike Wolfstone
<mikewolfstone@...> wrote:
>
> There is no endless loop problem. I just can't get the code to
forward the
> email Item I have identified and selected.
>
>
>
>
> ________________________________
> From: Toby Bierly toby@...
> To: AccessDevelopers@yahoogroups.com
> Sent: Sun, July 3, 2011 7:27:23 PM
> Subject: Re: [AccessDevelopers] Re: Finding outlook email items and
selectively
> forwarding them
>
> Â
> I haven't tried test running the code or debugging to watch the
values, but in
> regards to the endless loop, it looks like intitem variable is
incremented
> inside the loop, so I was curious how that could result in an endless
loop. Â At
> some point it would have to get larger than intIndx, right?
>
> Thanks,
> Toby
>
>
> ________________________________
> From: GiorgioR [mailto:giorgio_rovelli@...]
> >To: AccessDevelopers@yahoogroups.com
> >Sent: Sun, 03 Jul 2011 16:38:15 -0700
> >Subject: [AccessDevelopers] Re: Finding outlook email items and
selectively
> >forwarding them
> >
> >Â
> >Mike, I don't know if you're using the Public Sub
> >GetContactDetailsFromContactList but this to me seems wrong:
> >Distribution Items(AddressLists)
> >What's Distribution? And AddressLists is an undefined variable.
> >I think you meant to type
> >Set objItems = olContactFolder.Items(AddressLists)
> >instead
> >and also
> >Â Â Â While intitem < intIndx
> >Â Â Â Â Â Â Â If Not Len(arrItems(intitem, 0))
> 0 Then GoTo SkipAdd
> >Â Â Â Â Â Â Â If Left(arrItems(intitem, 0), 23)
= "Undeliverable: Invoice " Or _
> >Â Â Â Â Â Â Â Â Â Â Â
Left(arrItems(intitem, 0), 15) = "failure notice " Then
> >Â Â Â Â Â Â Â Â Â Â Â Â Â Â
 arrIndx(intIndx2) = intitem
> >Â Â Â Â Â Â Â Â Â Â Â Â Â Â
 intIndx2 = intIndx2 + 1
> >Â Â Â Â Â Â Â Â Â Â Â Â Â Â
 List2.AddItem (arrItems(intitem, 0) & ";" &
> >Right(arrItems(intitem, 1), 40) & ";" & arrItems(intitem, 2))
> >Â Â Â Â Â Â Â End If
> >SkipAdd:
> >Â Â Â intitem = intitem + 1
> >Â Â Â Wend
> >in Private Sub cmdScan_Click()
> >goes into an endless loop.
> >Giorgio
> >
> >--- In AccessDevelopers@yahoogroups.com, Mike Wolfstone
mikewolfstone@
> >wrote:
> >>
> >> With the current code, it fails the IF check for a mail
item and doesn't
> >>email
> >>
> >> anything.
> >> If I comment out the IF -> Endif, it fails on a type
mismatch at
> >> 'set objitem = objitem2'
> >> I've read the documentation (outlook VBA) and gotten samples from
here and
> >>other
> >>
> >> sites,
> >> but no matter how I manipulate the code (the lines commented out
are things I
>
> >> have tried),ÂÂ
> >>
> >> I can't quite get Outlook to recognize the item I have selected and
forward
> >it.
> >> Anything you might suggest would be welcomed.
> >> Mike
> >>
> >>
> >>
> >>
> >> ________________________________
> >> From: GiorgioR giorgio_rovelli@
> >> To: AccessDevelopers@yahoogroups.com
> >> Sent: Fri, July 1, 2011 12:39:48 AM
> >> Subject: [AccessDevelopers] Re: Finding outlook email items and
selectively
> >> forwarding them
> >>
> >> ÂÂ
> >> Mike,
> >> I suppose you mean the Private Sub cmdScan_Click() in frmTest calls
the
> >> GetEmailSpecificsFromOutlook sub but I see it run to completion,
where's the
> >> problem?
> >> Giorgio
> >>
> >> --- In AccessDevelopers@yahoogroups.com, Mike Wolfstone
mikewolfstone@
> >> wrote:
> >> >
> >> > Giorgio,
> >> > The code to email forward is in the .bas moduule.
> >> > The code is not complete. I build my automation
apps so I can test them
> >>along
> >>
> >> >
> >> > the way and then clean out the chaff.
> >> > The Scan (sub) logic calls the .bas module and that's where I
have the
> >> problem.
> >> > Mike
> >> >
> >> >
> >> >
> >> >
> >> > ________________________________
> >> > From: GiorgioR giorgio_rovelli@
> >> > To: AccessDevelopers@yahoogroups.com
> >> > Sent: Thu, June 30, 2011 6:00:32 AM
> >> > Subject: [AccessDevelopers] Re: Finding outlook email items and
selectively
>
> >> > forwarding them
> >> >
> >> > ÂÂÂ
> >> > Hi Mike, have you written the code to send the chosen item
anywhere in the
> >>VBA
> >>
> >>
> >> > code or do you need that?
> >> > Giorgio
> >> >
> >> > --- In AccessDevelopers@yahoogroups.com, "mikewolfstone"
<mikewolfstone@>
> >> > wrote:
> >> > >
> >> > > I uploaded the file. It is named FindTeamCust.mdb with a tag of
> >> > >ForwardEmailSelectively.
> >> > > Thanks for any help you can provide.
> >> > >
> >> > > --- In AccessDevelopers@yahoogroups.com, "giorgio_rovelli"
> >><giorgio_rovelli@>
> >>
> >> >
> >> > >wrote:
> >> > > >
> >> > > > Hi, can you upload the mdb/accdb to the Files section?
> >> > > >
> >> > > > --- In AccessDevelopers@yahoogroups.com, "mikewolfstone"
<mikewolfstone@>
> >>
> >> > >wrote:
> >> > > > >
> >> > > > > I have an Access program that reads the outlook inbox and
extracts
> >> >certain
> >> >
> >> > >data (subject, objectID, received date) and builds a list of
those items. It
> >>
> >> > >then selects specific conditions in the subject and further
selects those
> >>for
> >>
> >>
> >> > >email forwarding. I can get to that point and identify the item
to forward,
> >
> >> >but
> >> >
> >> > >the Outlook API doesn't fit the documentation. I need to send
(forward) an
>
> >> >inbox
> >> >
> >> > >item to a new email address. Any thoughts?
> >> > > > > The error I get on the activeinspector.currentitem.forward
statement is
> >>
> >> > >"Method is not supported by the object"
> >> > > > >
> >> > > >
> >> > >
> >> >
> >>
> >
>

__._,_.___

Reply to sender | Reply to group | Reply via web post | Start a New Topic

Messages in this topic (14)

Recent Activity:

• New Members 2

Visit Your Group

Please zip all files prior to uploading to Files section.

Switch to: Text-Only, Daily Digest • Unsubscribe • Terms of Use

.

__,_._,___