Solved VBA Code not looping through Outlook inbox (1 Viewer)

[baig1984]

Hi,
Need Help
i am trying to read emails from outlook for today and updating the access table based on specific keyword. however it just updates the first record and does not look for any other email. also it just goes not Elseif section of code even if there is first keyword is present in email
table has ID | StaffName | staffemail | availibility Fields.

Public Sub avilibility_status()
Dim outlookApp
  Dim olNs As Outlook.Namespace
  Dim Fldr As Outlook.MAPIFolder
  Dim olMail As Variant
  Dim myTasks
  Dim sir() As String

  'Set outlookApp = New Outlook.Application
  Set outlookApp = CreateObject("Outlook.Application")

  Set olNs = outlookApp.GetNamespace("MAPI")
  Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
  Set myTasks = Fldr.Items

  For Each olMail In myTasks
    If olMail.ReceivedTime >= Date And (InStr(1, olMail.Body, "Yes", vbTextCompare) > 0) Then
      'olMail.Display
      Me.av_status = "Available"
      Me.txtsender = olMail.SenderEmailAddress
      DoCmd.SetWarnings False
      DoCmd.RunSQL "update table1 set availibility = '" & Me.av_status & "' where staffemail = '" & Me.txtsender & "'"
MsgBox "updated"
DoCmd.SetWarnings True
            ElseIf olMail.ReceivedTime >= Date And (InStr(1, olMail.Body, "No", vbTextCompare) > 0) Then
      'olMail.Display
      Me.av_status = "Not Available"
      Me.txtsender = olMail.SenderEmailAddress
      DoCmd.SetWarnings False
          DoCmd.RunSQL "update table1 set availibility = '" & Me.av_status & "' where staffemail = '" & Me.txtsender & "'"
MsgBox "updated"
DoCmd.SetWarnings True
      Exit For
    End If
  Next
End Sub

(email addresses not present in attached file)

 

[Isaac]

Your indentation, while it exists, is very confusing and a bit off, which probably makes the solution difficult to spot:

You have EXIT FOR after the first elseif condition is met. therefore, the loop will exit.

 

[baig1984]

Your indentation, while it exists, is very confusing and a bit off, which probably makes the solution difficult to spot:

You have EXIT FOR after the first elseif condition is met. therefore, the loop will exit.

i found this piece of code for excel online and trying to make it work for access but failed...Can u amend it please ...i am newbie

 

[Isaac]

What do you want to do in plain english?

 

[baig1984]

What do you want to do in plain english?

i want VBA to scan the inbox for emails that are from todays date and if email contain a word "YES" then it should update the availability field of table to available based sender's email address and if the email has word "NO" then it should update the availability field of table to not available.
so that i won't have to run code manually for each email manually.

 

[Isaac]

Right now you're selecting which record to update based on something like Me.Controlname - but never having assigned a value to Me.Controlname
I'm thinking you'll need to perform the update more like - where email address = & olMail.senderemailaddress (aircode, no syntax included)

This code has a ways to go before it has any chance of doing what you want. If I have time to attempt a full re-write later today I will.
Another enthusiast with time may come along before I do that. But perhaps you can give it a try based on my feedback so far.

1) don't exit for after the first one runs, otherwise it will only do one.
2) consider using DateDiff to compare ReceivedTime vs. Now(), in order to get some clarity around that
3) consider what email address is literally in your table, vs. what you are extracting from the email - something like olMail.SenderEmail (look it up on microsoft)

 

[Gasman]

It appears after you get your first No, that is it, you exit, it's done, nothing more to do?

Set a breakpoint and walk through your code with F8.
See my link for Debugging Access. You are going to have to learn how sometime, may as well start now. It wil save you so much time in the future and repay the time spent over and over again.

 

[baig1984]

It appears after you get your first No, that is it, you exit, it's done, nothing more to do?

Set a breakpoint and walk through your code with F8.
See my link for Debugging Access. You are going to have to learn how sometime, may as well start now. It will save you so much time in the future and repay the time spent over and over again.

Hi,
Followed your advice managed to get it work. but SenderEmailAddress property does not contain a standard email address for internal contacts.
for example for below example

alpha.bravo@abc.com

for internal emails it had a value similar to this:

/O=ABC/CN=RECIPIENTS/CN=BRAVOSS6738

Is it possible that this code keeps running in background when i m doing other things with different other forms by keeping this form open in hidden status?

Dim outlookApp
  Dim olNs As Outlook.Namespace
  Dim Fldr As Outlook.MAPIFolder
  Dim olMail As Variant
  Dim myTasks
  Dim sir() As String

  Set outlookApp = CreateObject("Outlook.Application")

  Set olNs = outlookApp.GetNamespace("MAPI")
  Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
  Set myTasks = Fldr.Items

  For Each olMail In myTasks
 
    If olMail.ReceivedTime >= Date And (InStr(1, olMail.Body, "Yes", vbTextCompare) > 0) Then
      'olMail.Display
      Me.txtsender = olMail.SenderEmailAddress
      Me.txtbody = "Available"
      Me.Check7 = True
      
      DoCmd.SetWarnings False
      DoCmd.RunSQL "update table1 set availibility = '" & Me.av_status & "' where staffemail = '" & Me.txtsender & "'"
MsgBox "updated"
DoCmd.SetWarnings True
            ElseIf olMail.ReceivedTime >= Date And (InStr(1, olMail.Body, "No", vbTextCompare) > 0) Then
      'olMail.Display
      Me.txtsender = olMail.SenderEmailAddress
      'Me.txtsender = olMail.Sender.GetExchangeUser().PrimarySmtpAddress
      Me.txtbody = "Not Available"
      Me.Check7 = False
      DoCmd.SetWarnings False
          DoCmd.RunSQL "update table1 set availibility = '" & Me.av_status & "' where staffemail = '" & Me.txtsender & "'"
MsgBox "updated"
DoCmd.SetWarnings True

    End If
  Next

 

[Gasman]

If you indent your code correctly, it is much easier to read and find the bugs?

Sub Indent()
    Dim outlookApp
    Dim olNs As Outlook.Namespace
    Dim Fldr As Outlook.MAPIFolder
    Dim olMail As Variant
    Dim myTasks
    Dim sir() As String

    Set outlookApp = CreateObject("Outlook.Application")

    Set olNs = outlookApp.GetNamespace("MAPI")
    Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
    Set myTasks = Fldr.Items

    For Each olMail In myTasks

        If olMail.ReceivedTime >= Date And (InStr(1, olMail.body, "Yes", vbTextCompare) > 0) Then
            'olMail.Display
            Me.txtsender = olMail.SenderEmailAddress
            Me.txtbody = "Available"
            Me.Check7 = True

            DoCmd.SetWarnings False
            DoCmd.RunSQL "update table1 set availibility = '" & Me.av_status & "' where staffemail = '" & Me.txtsender & "'"
            MsgBox "updated"
            DoCmd.SetWarnings True
        ElseIf olMail.ReceivedTime >= Date And (InStr(1, olMail.body, "No", vbTextCompare) > 0) Then
            'olMail.Display
            Me.txtsender = olMail.SenderEmailAddress
            'Me.txtsender = olMail.Sender.GetExchangeUser().PrimarySmtpAddress
            Me.txtbody = "Not Available"
            Me.Check7 = False
            DoCmd.SetWarnings False
            DoCmd.RunSQL "update table1 set availibility = '" & Me.av_status & "' where staffemail = '" & Me.txtsender & "'"
            MsgBox "updated"
            DoCmd.SetWarnings True

        End If
    Next
End Sub

The code will run until the end whilst the form is open, whether hidden or not.
If it is for internal email addresses, try and find just the name field, as Outlook will resolve the name to the address, or just look at the email object for where a standard email address is stored.?