[Last Call] Learn about multicloud storage options and how to improve your company's cloud strategy. Register Now

x
?
Solved

VBA Question - Where to place a function within the code?

Posted on 2006-06-21
15
Medium Priority
?
312 Views
Last Modified: 2008-01-16

I have a sub procedure which calls a function.  Does the function code have to be within this:

Public Sub ImportOutlookItems()

End Sub

Or can it be outside?

Here is the code as I currently have, however when it runs it crashes access ?

--------------------------------------------------------------------------------------------

Option Compare Database

Function ParseTextLinePair(strSource As String, strLabel As String)
    Dim intLocLabel As Integer
    Dim intLocCRLF As Integer
    Dim intLenLabel As Integer
    Dim strText As String
   
    ' locate the label in the source text
    intLocLabel = InStr(strSource, strLabel)
    intLenLabel = Len(strLabel)
        If intLocLabel > 0 Then
        intLocCRLF = InStr(intLocLabel, strSource, vbCrLf)
        If intLocCRLF > 0 Then
            intLocLabel = intLocLabel + intLenLabel
            strText = Mid(strSource, _
                            intLocLabel, _
                            intLocCRLF - intLocLabel)
        Else
            intLocLabel = Mid(strSource, intLocLabel + intLenLabel)
        End If
    End If
    ParseTextLinePair = Trim(strText)
End Function


Public Sub ImportOutlookItems()
    Dim Olapp As Outlook.Application
    Dim Olmapi As Outlook.NameSpace
    Dim Olfolder As Outlook.MAPIFolder
    Dim OlNetwork As Outlook.MAPIFolder
    Dim OlMail As Object 'Have to late bind as appointments e.t.c screw it up
    Dim OlItems As Outlook.Items
    Dim OlRecips As Outlook.Recipients
    Dim OlRecip As Outlook.Recipient
    Dim Rst As Recordset
    Set Rst = CurrentDb.OpenRecordset("tbl_Temp") 'Open table tbl_temp
'Create a connection to outlook
    Set Olapp = CreateObject("Outlook.Application")
    Set Olmapi = Olapp.GetNamespace("MAPI")
'Open the inbox
    Set Olfolder = Olmapi.GetDefaultFolder(olFolderInbox)
    Set OlItems = Olfolder.Items

'Set up the folders the mails are going to be deposited in
    Set OlNetwork = Olfolder.Folders("Network")
'Set up a loop to run till the inbox is empty (otherwise it skips some)
    Do Until OlItems.Count = 0
'Reset the olitems object otherwise new incoming mails and moving mails get missed
    Set OlItems = Olfolder.Items
    For Each OlMail In OlItems
'For each mail in the collection check the subject line and process accordingly
    If OlMail.UnRead = True Then
        OlMail.UnRead = False 'Mark mail as read
        Rst.AddNew
        Rst!Name = OlMail.SenderName
        If InStr(1, OlMail.Subject, "Network Review") > 0 Then
            Rst!Status = "Attending"
            Rst!datesent = OlMail.ReceivedTime
           Rst!Content = ParseTextLinePair(OlMail.Body)
            OlMail.Move OlNetwork
        End If
        Rst.Update
    End If
    Next
    Loop
    MsgBox "Your wish is my command. New mails have been checked. Please check the tbl_temp for details", vbOKOnly
End Sub

0
Comment
Question by:andyw27
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 7
  • 5
  • 3
15 Comments
 
LVL 29

Expert Comment

by:leonstryker
ID: 16954777
Which line does it crash on?
0
 

Author Comment

by:andyw27
ID: 16954810

If I end the outlook.exe task is fails on this line:

Do Until OlItems.Count = 0

It does however add the desired information to the database.
0
 
LVL 29

Expert Comment

by:leonstryker
ID: 16954856
What do you mean by "If I end the outlook.exe task "?  Are you manually closing Outlook?
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:andyw27
ID: 16954880

Yes, closing outlook causes Access to unfreeze
0
 
LVL 29

Expert Comment

by:leonstryker
ID: 16954911
And does it work correctly (and not crash) if you do not close Outlook?
0
 
LVL 1

Expert Comment

by:beckw
ID: 16954924
Hi,

You're putting Outlook into a continuos loop. The do loop will only exit if no more email exist. The code within the do loop only moves the email if if meets the criteria you've set ie. the email must be unread etc. If you've got any read emails in there then the loop will never end
0
 

Author Comment

by:andyw27
ID: 16954937

If I don't close outlook, access freezes.

Freezes but still seems to insert the information into the database. so its appears to be going once round.

Maybe its getting stuck in some kind of infinite loop
0
 
LVL 1

Expert Comment

by:beckw
ID: 16954944
Just one more quick point, can't you just comment out the 'Do Until OlItems.Count = 0' and 'Loop' lines. The 'For Each OlMail In OlItems' loop will make sure every email gets checked.
0
 

Author Comment

by:andyw27
ID: 16954966

Ah that sound like flaw.

Any suggestions how I can get round this.

Id there away of counting the emails that are in the folder first and then only running the code for that amount of times ?

0
 

Author Comment

by:andyw27
ID: 16954994

I've found a piece of code:

MapiFolder.Items.Count

I saved this to a variable.

Any idea how can changed the do loop to a loop that will only repeat this amount of time?
0
 
LVL 1

Expert Comment

by:beckw
ID: 16955008
What happens when you comment out the 'Do Until OlItems.Count = 0' and 'Loop' lines. The 'For Each OlMail In OlItems' will only go through each email once.

ie if you have 500 emails in your inbox then the For Each line will go through 500 times. If you've only got 2 emails in your inbox then the For Each line will only go through 2 emals.

Your code with the 2 lines commented out:

Option Compare Database

Function ParseTextLinePair(strSource As String, strLabel As String)
    Dim intLocLabel As Integer
    Dim intLocCRLF As Integer
    Dim intLenLabel As Integer
    Dim strText As String
   
    ' locate the label in the source text
    intLocLabel = InStr(strSource, strLabel)
    intLenLabel = Len(strLabel)
        If intLocLabel > 0 Then
        intLocCRLF = InStr(intLocLabel, strSource, vbCrLf)
        If intLocCRLF > 0 Then
            intLocLabel = intLocLabel + intLenLabel
            strText = Mid(strSource, _
                            intLocLabel, _
                            intLocCRLF - intLocLabel)
        Else
            intLocLabel = Mid(strSource, intLocLabel + intLenLabel)
        End If
    End If
    ParseTextLinePair = Trim(strText)
End Function


Public Sub ImportOutlookItems()
    Dim Olapp As Outlook.Application
    Dim Olmapi As Outlook.NameSpace
    Dim Olfolder As Outlook.MAPIFolder
    Dim OlNetwork As Outlook.MAPIFolder
    Dim OlMail As Object 'Have to late bind as appointments e.t.c screw it up
    Dim OlItems As Outlook.Items
    Dim OlRecips As Outlook.Recipients
    Dim OlRecip As Outlook.Recipient
    Dim Rst As Recordset
    Set Rst = CurrentDb.OpenRecordset("tbl_Temp") 'Open table tbl_temp
'Create a connection to outlook
    Set Olapp = CreateObject("Outlook.Application")
    Set Olmapi = Olapp.GetNamespace("MAPI")
'Open the inbox
    Set Olfolder = Olmapi.GetDefaultFolder(olFolderInbox)
    Set OlItems = Olfolder.Items

'Set up the folders the mails are going to be deposited in
    Set OlNetwork = Olfolder.Folders("Network")
'Set up a loop to run till the inbox is empty (otherwise it skips some)
    'Do Until OlItems.Count = 0
'Reset the olitems object otherwise new incoming mails and moving mails get missed
    Set OlItems = Olfolder.Items
    For Each OlMail In OlItems
'For each mail in the collection check the subject line and process accordingly
    If OlMail.UnRead = True Then
        OlMail.UnRead = False 'Mark mail as read
        Rst.AddNew
        Rst!Name = OlMail.SenderName
        If InStr(1, OlMail.Subject, "Network Review") > 0 Then
            Rst!Status = "Attending"
            Rst!datesent = OlMail.ReceivedTime
           Rst!Content = ParseTextLinePair(OlMail.Body)
            OlMail.Move OlNetwork
        End If
        Rst.Update
    End If
    Next
    'Loop
    MsgBox "Your wish is my command. New mails have been checked. Please check the tbl_temp for details", vbOKOnly
End Sub
0
 

Author Comment

by:andyw27
ID: 16955112

That kind of work although it only takes the first two emails, anymore and you have to run it again.
0
 
LVL 1

Accepted Solution

by:
beckw earned 2000 total points
ID: 16955348
The quick fix would be to add DoEvents just under you Do Loop as follows:

Option Compare Database

Function ParseTextLinePair(strSource As String, strLabel As String)
    Dim intLocLabel As Integer
    Dim intLocCRLF As Integer
    Dim intLenLabel As Integer
    Dim strText As String
   
    ' locate the label in the source text
    intLocLabel = InStr(strSource, strLabel)
    intLenLabel = Len(strLabel)
        If intLocLabel > 0 Then
        intLocCRLF = InStr(intLocLabel, strSource, vbCrLf)
        If intLocCRLF > 0 Then
            intLocLabel = intLocLabel + intLenLabel
            strText = Mid(strSource, _
                            intLocLabel, _
                            intLocCRLF - intLocLabel)
        Else
            intLocLabel = Mid(strSource, intLocLabel + intLenLabel)
        End If
    End If
    ParseTextLinePair = Trim(strText)
End Function


Public Sub ImportOutlookItems()
    Dim Olapp As Outlook.Application
    Dim Olmapi As Outlook.NameSpace
    Dim Olfolder As Outlook.MAPIFolder
    Dim OlNetwork As Outlook.MAPIFolder
    Dim OlMail As Object 'Have to late bind as appointments e.t.c screw it up
    Dim OlItems As Outlook.Items
    Dim OlRecips As Outlook.Recipients
    Dim OlRecip As Outlook.Recipient
    Dim Rst As Recordset
    Set Rst = CurrentDb.OpenRecordset("tbl_Temp") 'Open table tbl_temp
'Create a connection to outlook
    Set Olapp = CreateObject("Outlook.Application")
    Set Olmapi = Olapp.GetNamespace("MAPI")
'Open the inbox
    Set Olfolder = Olmapi.GetDefaultFolder(olFolderInbox)
    Set OlItems = Olfolder.Items

'Set up the folders the mails are going to be deposited in
    Set OlNetwork = Olfolder.Folders("Network")
'Set up a loop to run till the inbox is empty (otherwise it skips some)
    Do Until OlItems.Count = 0
        DoEvents
'Reset the olitems object otherwise new incoming mails and moving mails get missed
    Set OlItems = Olfolder.Items
    For Each OlMail In OlItems
'For each mail in the collection check the subject line and process accordingly
    If OlMail.UnRead = True Then
        OlMail.UnRead = False 'Mark mail as read
        Rst.AddNew
        Rst!Name = OlMail.SenderName
        If InStr(1, OlMail.Subject, "Network Review") > 0 Then
            Rst!Status = "Attending"
            Rst!datesent = OlMail.ReceivedTime
           Rst!Content = ParseTextLinePair(OlMail.Body)
            OlMail.Move OlNetwork
        End If
        Rst.Update
    End If
    Next
    Loop
    MsgBox "Your wish is my command. New mails have been checked. Please check the tbl_temp for details", vbOKOnly
End Sub

All 'DoEvents' does is lets other programs have the focus. (Adding the sleep API call in will also stop the processor from running high)

The best solution if you have Outlook 2000 or above (might be worth opening another question as i can't help tonight) is to modify the code and have it in Outlooks 'Application_NewMail' event. This will then run whenever you get a new email.











.




 This is likely to only way you'll be able to get it to work constantly is to pause the code by using the sleep API

First, you need to place a declaration in a public
module:

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)


Then wherever I need the pause all I have to do is type a simple line of
code with the variable in milliseconds.  For example, to pause the operation
of a sub for 5 seconds, I would put the following:


Sleep (5000)

0
 
LVL 1

Expert Comment

by:beckw
ID: 16955361
Sorry, forgot to delete the bottom of the last reply. Just forget everything below the
This is likely to only way you'll be able to get it to work ..................... line.
0
 

Author Comment

by:andyw27
ID: 16955518

Thanks that has worked.
0

Featured Post

Tech or Treat! - Giveaway

Submit an article about your scariest tech experience—and the solution—and you’ll be automatically entered to win one of 4 fantastic tech gadgets.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction While answering a recent question about filtering a custom class collection, I realized that this could be accomplished with very little code by using the ScriptControl (SC) library.  This article will introduce you to the SC library a…
The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
Suggested Courses

650 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question