Link to home
Start Free TrialLog in
Avatar of heinzcr
heinzcr

asked on

I have an outlook macro the keeps giving me an ARRAY OUT OF BOUNDS error on Set myMailItem = mySubFolder.Items(i). Please review my code and make suggestions where you see fit.

Public Const DerivPath = "\\Houdata01\Investments\TRADING\EXCEL\DERIV\PositionDistribution.xls"
Public Const CIPath = "\\Houdata01\Investments\Canada\CIportfolio.xls"
Public Const Receipients = "Daily Options" '"erik.benke@aiminvestments.com; robert.botard@aiminvestments.com; jeffrey.galloway@aiminvestments.com; roger.mortimer@aiminvestments.com; glen.hilton@aiminvestments.com; dean.pancoast@aiminvestments.com"

Public Sub Main()
   
    If MsgBox("Update Call Overwrite Model?", vbOKCancel, Update) = vbOK Then
        EmailHandler
    Else
        GoTo EndOfMain
    End If
   
EndOfMain:

End Sub
Private Sub EmailHandler()

Dim myNameSpace As NameSpace
Dim myFolder As MAPIFolder
Dim mySubFolder As MAPIFolder
Dim myMailItem As MailItem
Dim myItems As Items
Dim myAttactment As Attachment
Dim myDate As Date
Dim myString As String
Dim i As Integer

Const myPath As String = "\\Houdata01\Investments\Derivatives\Archive\"
Const myFile As String = "Call_Overwrite_Model_JPM.xls"


    Set myNameSpace = Application.GetNamespace("MAPI")
   
    i = 1
    Set myFolder = myNameSpace.Folders(1)
    Do While myFolder.Name <> "Mailbox - #HOU-Derivatives"
        Set myFolder = myNameSpace.Folders(i)
        i = i + 1
    Loop
   
    i = 1
    Set mySubFolder = myFolder.Folders(1)
    Do While mySubFolder.Name <> "Call Overwrite Archive"
        Set mySubFolder = myFolder.Folders(i)
        i = i + 1
    Loop
   
    i = 1
    Do While myDate <> Date
        Set myMailItem = mySubFolder.Items(i)
        myDate = myMailItem.ReceivedTime
        myDate = VBA.FormatDateTime(myDate, vbShortDate)
        i = i + 1
    Loop
   
    Set myAttachment = myMailItem.Attachments(1)
    myAttachment.SaveAsFile myPath & myFile
    myAttachment.SaveAsFile myPath & "Call_Overwrite_Model_" & VBA.Month(myDate) & "_" & VBA.Day(myDate) & "_" & VBA.Year(myDate) & ".xls"
       
End Sub

Private Sub AutoEmailer()

Dim myNameSpace As NameSpace
Dim myFolder As MAPIFolder
Dim mySubFolder As MAPIFolder
Dim myMailItem As MailItem
Dim myAttactment As Attachment
Dim i As Integer

Set myNameSpace = Application.GetNamespace("MAPI")
   
    'Set folder to "Mailbox - #HOU-Derivatives"
    i = 1
    Set myFolder = myNameSpace.Folders(1)
    Do While myFolder.Name <> "Mailbox - #HOU-Derivatives"
        Set myFolder = myNameSpace.Folders(i)
        i = i + 1
    Loop
   
    'Set sub folder to "Inbox"
    i = 1
    Set mySubFolder = myFolder.Folders(1)
    Do While mySubFolder.Name <> "Inbox"
        Set mySubFolder = myFolder.Folders(i)
        i = i + 1
    Loop
   
Set myMailItem = CreateItem(olMailItem)
With myMailItem
    .To = Receipients
    .Subject = "*** Daily Option Positions ***"
    .Body = ""
    .SentOnBehalfOfName = "#HOU-Derivatives"
End With

Set myAttachment = myMailItem.Attachments
Set myAttachment = myAttachment.Add(DerivPath)

myMailItem.Send

End Sub

Private Sub SFAutoEmailer()

Dim myNameSpace As NameSpace
Dim myFolder As MAPIFolder
Dim mySubFolder As MAPIFolder
Dim myMailItem As MailItem
Dim myAttactment As Attachment
Dim i As Integer

Set myNameSpace = Application.GetNamespace("MAPI")
   
    'Set folder to "Mailbox - #HOU-Derivatives"
    i = 1
    Set myFolder = myNameSpace.Folders(1)
    Do While myFolder.Name <> "Mailbox - Benke, Erik G"
        Set myFolder = myNameSpace.Folders(i)
        i = i + 1
    Loop
   
    'Set sub folder to "Inbox"
    i = 1
    Set mySubFolder = myFolder.Folders(1)
    Do While mySubFolder.Name <> "Inbox"
        Set mySubFolder = myFolder.Folders(i)
        i = i + 1
    Loop
   
Set myMailItem = CreateItem(olMailItem)
With myMailItem
    .To = "Roger.Mortimer@aiminvestments.com; Glen.Hilton@aiminvestments.com; Erik.Benke@aiminvestments.com"
    .Subject = "*** Canada Income Positions ***"
    .Body = ""
    .SentOnBehalfOfName = "#HOU-Derivatives"
End With

Set myAttachment = myMailItem.Attachments
Set myAttachment = myAttachment.Add(CIPath)

myMailItem.Send

End Sub


ASKER CERTIFIED SOLUTION
Avatar of GrahamSkan
GrahamSkan
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial