VBA in excel and outlook

dlindamood2000 · November 28th, 2006, 08:15 AM

I like the idea of option #2. I could check outlook periodically to see if the new mail has arrived. then I could run the macro from excel to get the attachment. I think that by running the macro from excel the attachment excel file could be linked to my already opened excel file simply by renaming the attachment appropriatly and keeping the file open. However, being a VBA novice, would you be able to help me write this type of code that orriginates in excel, yet opens outlook and retrieves the attachment?

maccas · November 28th, 2006, 08:38 AM

Something like this should get you started then...

Code:

Sub Test()

Dim olApp As New Outlook.Application
Dim olNameSp As Outlook.Namespace
Dim olInbox As Outlook.MAPIFolder
Dim olExplorer As Outlook.Explorer
Dim olMail As Outlook.MailItem
Dim OutOpen As Boolean

Dim i As Integer
Dim wbNew As Workbook

Const strFPath As String = "C:\Text.xls"

    ' Check to see if there's an explorer window open
    ' If not then open up a new one
    OutOpen = True
    Set olNameSp = olApp.GetNamespace("MAPI")
    Set olInbox = olNameSp.GetDefaultFolder(olFolderInbox)

    Set olExplorer = olApp.ActiveExplorer
    If TypeName(olExplorer) = "Nothing" Then
        OutOpen = False
        Set olExplorer = olInbox.GetExplorer
    End If

    ' You don't need to show Outlook ...
    'If Not OutOpen Then myExplorer.Display

    ' Loop through all items in the inbox
    For i = 1 To olInbox.Items.Count

        ' Set the Mail object
        Set olMail = olInbox.Items.Item(i)

        'MsgBox olMail.Subject

        ' If there' a suitably entitled e-mail with attachments then...
        If olMail.Subject = "" And olMail.Attachments.Count > 0 Then

            ' Save the attachment
            olMail.Attachments.Item(1).SaveAsFile Path:=strFPath

            ' Open the new file
            Set wbNew = Workbooks.Open(Filename:=strFPath, UpdateLinks:=True, ReadOnly:=True)

            ' Do stuff

            ' Close the new file
            wbNew.Close

        End If

    Next i

    'Release memory.
    Set olApp = Nothing
    Set olNameSp = Nothing
    Set olInbox = Nothing
    Set olExplorer = Nothing
    Set olMail = Nothing

End Sub

dlindamood2000 · November 28th, 2006, 03:09 PM

When I search (loop) for the attachments using the statement: If olMail.Subject = "" And olMail.Attachments.Count > 0 Can I use wildcards to look for variations of what I am looking for. Also, the attachment comes every day with the same name. How can I be sure to get the most current attachment. Can I look for files that have todays date of creation?

dlindamood2000 · December 1st, 2006, 02:13 PM

OK, I sort of figured it out. Here is what I finally ended up using for anyone interested.

Sub getabsrpt()
Dim olApp As New Outlook.Application
Dim olNameSp As Outlook.Namespace
Dim olInbox As Outlook.MAPIFolder
Dim olExplorer As Outlook.Explorer
Dim olMail As Outlook.MailItem
Dim OutOpen As Boolean

Dim i As Integer
Dim wbNew As Workbook
Dim todaydt As Date
Const strFPath As String = "H:\Text.xls"
    todaydt = [bu158]
    ' Check to see if there's an explorer window open
    ' If not then open up a new one
    OutOpen = True
    Set olNameSp = olApp.GetNamespace("MAPI")
    Set olInbox = olNameSp.GetDefaultFolder(olFolderInbox)

    Set olExplorer = olApp.ActiveExplorer
    If TypeName(olExplorer) = "Nothing" Then
        OutOpen = False
        Set olExplorer = olInbox.GetExplorer
    End If

    ' You don't need to show Outlook ...
    'If Not OutOpen Then myExplorer.Display

    ' Loop through all items in the inbox
    i = olInbox.Items.Count
   Do While i <> 1
On Error Resume Next
        ' Set the Mail object
        Set olMail = olInbox.Items.Item(i)

        'MsgBox olMail.Subject
       ' [b3] = olMail.Subject
        '[b4] = olMail.ReceivedTime
        ' If there' a suitably entitled e-mail with attachments then...
        If olMail.Subject = "PM attendance update" And olMail.ReceivedTime >= todaydt And olMail.Attachments.Count > 0 Then
          i = 2

            ' Save the attachment
            olMail.Attachments.Item(1).SaveAsFile Path:=strFPath

            ' Open the new file
            Set wbNew = Workbooks.Open(filename:=strFPath, UpdateLinks:=True, ReadOnly:=False)
            Application.DisplayAlerts = False
            ActiveWorkbook.Sheets(1).Name = "ADGD"
            ActiveWorkbook.SaveAs ("H:\2006 2007\abs-rpt.xls")
            End If
            ' Do stuff

            ' Close the new file
           ' wbNew.Close
        i = i - 1
    Loop
      ' [b1] = i

    'Release memory.
    Set olApp = Nothing
    Set olNameSp = Nothing
    Set olInbox = Nothing
    Set olExplorer = Nothing
    Set olMail = Nothing

End Sub

It works nearly perfictly... However, Sometimes the subject line in the email will say pm update, or pm attendance, or pm attendance update. What I would like to know now is how to possibly use wildcards when looping to search for the correct email. Or, if anyone has any other ideas. I would like to acknowledge MACCAS for excellent code and help. Thank you very much!

maccas · December 4th, 2006, 07:00 AM

You can use the LIKE operator to compare strings with wildcards. Look at the VBA help for more info on this one as the section is well written but I think the following should now work for you:

Code:

Option Explicit

Sub getabsrpt()

Dim olApp As New Outlook.Application
Dim olNameSp As Outlook.Namespace
Dim olInbox As Outlook.MAPIFolder
Dim olExplorer As Outlook.Explorer
Dim olMail As Outlook.MailItem
Dim OutOpen As Boolean

Dim i As Integer
Dim wbNew As Workbook
Dim sngLookHrs As Single
Dim dteLook As Date

Const strFPath As String = "H:\Text.xls"

    ' Ignores error of setting MailObject if another object is in the inbox
    On Error Resume Next

    ' Set date look range to be last 12 hours...
    sngLookHrs = 12
    dteLook = Now() - (sngLookHrs / 24)

    ' Check to see if there's an explorer window open
    ' If not then open up a new one
    OutOpen = True
    Set olNameSp = olApp.GetNamespace("MAPI")
    Set olInbox = olNameSp.GetDefaultFolder(olFolderInbox)

    Set olExplorer = olApp.ActiveExplorer
    If TypeName(olExplorer) = "Nothing" Then
        OutOpen = False
        Set olExplorer = olInbox.GetExplorer
    End If

    ' You don't need to show Outlook ...
    'If Not OutOpen Then myExplorer.Display

    ' Loop through all items in the inbox
    i = olInbox.Items.Count
    Do While i <> 1

        ' Set the Mail object
        Set olMail = olInbox.Items.Item(i)

        ' If there's a suitably entitled e-mail within the correct time frame and with attachments then...
        If olMail.Subject Like "*PM attendance*" And _
            olMail.ReceivedTime >= dteLook And _
            olMail.Attachments.Count > 0 Then

            ' Save the attachment
            olMail.Attachments.Item(1).SaveAsFile Path:=strFPath

            ' Open the new file
            Set wbNew = Workbooks.Open(Filename:=strFPath, UpdateLinks:=True, ReadOnly:=False)
            Application.DisplayAlerts = False
            ActiveWorkbook.Sheets(1).Name = "ADGD"
            ActiveWorkbook.SaveAs ("H:\2006 2007\abs-rpt.xls")

            ' Quit loop as found the correct e-mail
            Exit Do

        End If

        i = i - 1

    Loop

    'Release memory.
    Set olApp = Nothing
    Set olNameSp = Nothing
    Set olInbox = Nothing
    Set olExplorer = Nothing
    Set olMail = Nothing

End Sub

dlindamood2000 · December 4th, 2006, 04:27 PM

This is great! Thanks again for your great help. I am learning a great deal from this forum!

dlindamood2000 · December 7th, 2006, 08:21 AM

Just as I thought I had this woriking, the email sender changed the case of "PM attendance to pm attendance". Thus, the file was never opened. I needed to modify the olmail.subject line because it appears to be case sensitive. What is wrong with the following statement

If olMail.Subject Like "*PM*" Or olMail.Subject Like "*pm*" Or olMail.Subject Like "*Pm*" And _
olMail.ReceivedTime >= dteLook And _
olMail.Attachments.Count > 0 Then

The macro will open an attachement even if it does not fit all of the criteria. Sometimes it opens a PDF file and renames it an excel file. It will open files that are even older than 12 hours.

maccas · December 7th, 2006, 08:26 AM

You're mixing your ORs and your ANDs. Try:

If UCASE(olMail.Subject) Like "*PM*" And _
olMail.ReceivedTime >= dteLook And _
olMail.Attachments.Count > 0 Then

Maccas

maccas · December 7th, 2006, 08:29 AM

Sorry - just read all of your post. On the opening of PDF point - you may want to loop through all of the attachments to check which one looks like the required Excel file. A check to see whether the leftmost four charachters of the filename are ".xls" would be a good place to start...

dlindamood2000 · December 7th, 2006, 10:16 AM

The Suggestion with the UCASE worked well. Thanks!