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\T RADING\EXC EL\DERIV\P ositionDis tribution. xls"
Public Const CIPath = "\\Houdata01\Investments\C anada\CIpo rtfolio.xl s"
Public Const Receipients = "Daily Options" '"erik.benke@aiminvestment s.com; robert.botard@aiminvestmen ts.com; jeffrey.galloway@aiminvest ments.com; roger.mortimer@aiminvestme nts.com; glen.hilton@aiminvestments .com; dean.pancoast@aiminvestmen ts.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\D erivatives \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@aiminvestm ents.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
Public Const CIPath = "\\Houdata01\Investments\C
Public Const Receipients = "Daily Options" '"erik.benke@aiminvestment
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\D
Const myFile As String = "Call_Overwrite_Model_JPM.
Set myNameSpace = Application.GetNamespace("
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,
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("
'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("
'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@aiminvestm
.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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.