DebugGalpin
Board Regular
- Joined
- Jun 29, 2011
- Messages
- 175
Hi all,
I have a problem and need some guidance. I moved from onto a Windows 8 computer and Excel 2013 recently, and it has led to problems with a macro I had to download attachments from outlook folder.
The problem I have determined is that instead of starting from the most recent item it always starts from 17th June 2015 and works backwards through the folder to 2010 and then starts at the most recent item and works down to 18th June 2015. This is possibly the date I moved to the new computer? I'm not sure really. If I run this on my old computer it works correctly looping backwards from todays date.
These folders (25 of them) have 10,000 emails in them, not all with attachment, so I'd handled that by getting the macro to hit into its next for if item count was greater than 100 or the Date was less than 3 days ago. The choices at the moment seem to be take those out and have a macro that takes hours to run or seek some much needed assistance
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
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
objFdr4.Sort "ReceivedTime", True
For Each Item In objFdr4.Items
If Item.ReceivedTime > Range("DateT2") - 1 Then
I have a problem and need some guidance. I moved from onto a Windows 8 computer and Excel 2013 recently, and it has led to problems with a macro I had to download attachments from outlook folder.
The problem I have determined is that instead of starting from the most recent item it always starts from 17th June 2015 and works backwards through the folder to 2010 and then starts at the most recent item and works down to 18th June 2015. This is possibly the date I moved to the new computer? I'm not sure really. If I run this on my old computer it works correctly looping backwards from todays date.
These folders (25 of them) have 10,000 emails in them, not all with attachment, so I'd handled that by getting the macro to hit into its next for if item count was greater than 100 or the Date was less than 3 days ago. The choices at the moment seem to be take those out and have a macro that takes hours to run or seek some much needed assistance
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
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
objFdr4.Sort "ReceivedTime", True
For Each Item In objFdr4.Items
If Item.ReceivedTime > Range("DateT2") - 1 Then