DebugGalpin
Board Regular
- Joined
- Jun 29, 2011
- Messages
- 175
Morning All,
I have recently moved from Excel 2010 to 2013 and have hit a problem with a 2010 model I had built. The model in a nut shell runs through a list of shared Outlook folders and downloads any xls or csv attachments within a given date range. I noticed it was not working correctly today so added a couple of lines of code and found that the model no longer starts at the most recently received email and is starting at a date less than "DateT2-1" in the code. If I log into my old computer it does work so I know this is an Excel 2013 or Outlook 2013 issue, I just can't figure out why??
Thoughts??
In the Outlook folder (objFdr4) the most recent mail is from Monday 22nd 1:10:02 pm, Test1 shows me the first item it is checking is Wed 17/06/2015 6.59pm. It then exits that For Each as that is less than DateT2 - 1 (18/06/2015)
FYI there are about 50 outlook folders this model runs through each with well in excess of 1000 mails with attachment.
Looking forward to thoughts and comments
Cheers
Dave
Sub DownloadAllEmailAttachments()
On Error Resume Next
Dim olApp As Outlook.Application
Dim objNS As Outlook.Namespace
Dim objFdr As Outlook.Folder
Dim objFdr1 As Outlook.Folder
Dim objFdr2 As Outlook.Folder
Dim i As Integer
MacroTime = Now()
Range("TaskList").Cells.ClearContents
Application.Calculation = xlCalculationAutomatic
NewFolder = "COB " & Format(Range("DateT2"), "YYYYMMDD")
File = "W:\ExcelInput\Ops\Counterparty_Reconciliation\Broker Statements\" & NewFolder
If Len(Dir(File, vbDirectory)) = 0 Then
MkDir File
End If
s = 2
BNZCheck = 0
Control.Cells(12, 9) = 0
Do Until MailboxMapping.Cells(s, 1) = vbNullString
Control.Cells(12, 4) = Chr(186)
Control.Cells(12, 5) = "Downloading Files - " & MailboxMapping.Cells(s, 4)
'Control.Cells(12, 9) = 0
strFolder1 = MailboxMapping.Cells(s, 1)
strFolder2 = MailboxMapping.Cells(s, 2)
strFolder3 = MailboxMapping.Cells(s, 3)
strFolder4 = MailboxMapping.Cells(s, 4)
strFolder5 = MailboxMapping.Cells(s, 5)
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set objFdr = objNS.Folders(strFolder1)
Set objFdr1 = objFdr.Folders(strFolder2)
Set objFdr2 = objFdr1.Folders(strFolder3)
Set objFdr3 = objFdr2.Folders(strFolder4)
Set objFdr4 = objFdr3.Folders(strFolder5)
File = "W:\ExcelInput\Ops\Counterparty_Reconciliation\Broker Statements\COB " & Format(Range("DateT2"), "yyyymmdd")
i = 0
l = 0
For Each Item In objFdr4.Items
irowTest = Test1.Cells(Rows.Count, 1).End(xlUp).Row + 1
Test1.Cells(irowTest, 1) = Item.ReceivedTime
Test1.Cells(irowTest, 2) = Item.Subject
If Item.ReceivedTime > Range("DateT2") - 1 Then
For Each Atmt In Item.Attachments
If Right(Atmt.Filename, 3) = "xls" Or Right(Atmt.Filename, 3) = "csv" Or Right(Atmt.Filename, 3) = "XLS" Then
...
I have recently moved from Excel 2010 to 2013 and have hit a problem with a 2010 model I had built. The model in a nut shell runs through a list of shared Outlook folders and downloads any xls or csv attachments within a given date range. I noticed it was not working correctly today so added a couple of lines of code and found that the model no longer starts at the most recently received email and is starting at a date less than "DateT2-1" in the code. If I log into my old computer it does work so I know this is an Excel 2013 or Outlook 2013 issue, I just can't figure out why??
Thoughts??
In the Outlook folder (objFdr4) the most recent mail is from Monday 22nd 1:10:02 pm, Test1 shows me the first item it is checking is Wed 17/06/2015 6.59pm. It then exits that For Each as that is less than DateT2 - 1 (18/06/2015)
FYI there are about 50 outlook folders this model runs through each with well in excess of 1000 mails with attachment.
Looking forward to thoughts and comments
Cheers
Dave
Sub DownloadAllEmailAttachments()
On Error Resume Next
Dim olApp As Outlook.Application
Dim objNS As Outlook.Namespace
Dim objFdr As Outlook.Folder
Dim objFdr1 As Outlook.Folder
Dim objFdr2 As Outlook.Folder
Dim i As Integer
MacroTime = Now()
Range("TaskList").Cells.ClearContents
Application.Calculation = xlCalculationAutomatic
NewFolder = "COB " & Format(Range("DateT2"), "YYYYMMDD")
File = "W:\ExcelInput\Ops\Counterparty_Reconciliation\Broker Statements\" & NewFolder
If Len(Dir(File, vbDirectory)) = 0 Then
MkDir File
End If
s = 2
BNZCheck = 0
Control.Cells(12, 9) = 0
Do Until MailboxMapping.Cells(s, 1) = vbNullString
Control.Cells(12, 4) = Chr(186)
Control.Cells(12, 5) = "Downloading Files - " & MailboxMapping.Cells(s, 4)
'Control.Cells(12, 9) = 0
strFolder1 = MailboxMapping.Cells(s, 1)
strFolder2 = MailboxMapping.Cells(s, 2)
strFolder3 = MailboxMapping.Cells(s, 3)
strFolder4 = MailboxMapping.Cells(s, 4)
strFolder5 = MailboxMapping.Cells(s, 5)
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set objFdr = objNS.Folders(strFolder1)
Set objFdr1 = objFdr.Folders(strFolder2)
Set objFdr2 = objFdr1.Folders(strFolder3)
Set objFdr3 = objFdr2.Folders(strFolder4)
Set objFdr4 = objFdr3.Folders(strFolder5)
File = "W:\ExcelInput\Ops\Counterparty_Reconciliation\Broker Statements\COB " & Format(Range("DateT2"), "yyyymmdd")
i = 0
l = 0
For Each Item In objFdr4.Items
irowTest = Test1.Cells(Rows.Count, 1).End(xlUp).Row + 1
Test1.Cells(irowTest, 1) = Item.ReceivedTime
Test1.Cells(irowTest, 2) = Item.Subject
If Item.ReceivedTime > Range("DateT2") - 1 Then
For Each Atmt In Item.Attachments
If Right(Atmt.Filename, 3) = "xls" Or Right(Atmt.Filename, 3) = "csv" Or Right(Atmt.Filename, 3) = "XLS" Then
...