Johan90
10-04-2018, 04:06 AM
So I have a code that loops through mailboxes, I have used the base of this code for several different purposes so I am very confounded as to why it suddenly behaves differently.
What happens is that with this version it starts to read the mailbox bottom up, so y=1 will be the last (or the oldest unread mail) whereas in all previous versions it has started from the top (or the newest).
I used an override part in one version that could retrieve the desired mail/mails anywhere in the inbox order, so it would be nice to know that some random setting or seomthing dosent alter that.
Anyone have any ideas why?
Also for some reason I couldnt dim Outlook as object, this exact same piece of code on the same computer 15min later didnt work.
Sub SparaUtgifter()Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim Choice As String
Dim olApp As Variant 'Outlook.Application
Dim olNS As Variant 'Outlook.Namespace
Dim olInBox As Variant 'Outlook.MAPIFolder
Dim olItems As Variant 'Outlook.Items
Dim Ans As Long
Dim i As Long
Dim LastRow As Long
Dim parfld As String
Dim subfld As String
Dim strPath As String
Dim strFile As String
Dim rng As Range
Set olApp = CreateObject("Outlook.Application")
Set olNS = olApp.GetNamespace("MAPI")
parfld = Range("InboxUtlägg").Value
Set olInBox = olNS.Folders(parfld)
subfld2 = Range("InboxUtlägg").Offset(0, 1).Value
If Right(subfld2, 1) <> "/" Then subfld2 = subfld2 & "/"
CountSubFldrs = Len(subfld2) - Len(Replace(subfld2, "/", ""))
Do Until CountSubFldrs = 0
If subfld2 = "" Then
Else
subfld = Left(subfld2, InStr(subfld2, "/") - 1)
Set olInBox = olInBox.Folders(subfld)
x = Len(subfld) + 1
subfld2 = Right(subfld2, Len(subfld2) - x)
End If
CountSubFldrs = CountSubFldrs - 1
Loop
'~~> Check if there are any actual unread emails
If olInBox.Items.Restrict("[UnRead] = True").Count = 0 Then
MsgBox "NO Unread Email In Inbox"
Exit Sub
End If
Set olItems = olInBox.Items.Restrict("[UnRead] = True")
x = olItems.Restrict("[UnRead] = True").Count + 1
y = 1
nrEM = 0
Do Until y = x
'paste subject
Range("UtläggStart").Offset(0 + nrEM, 0).Value = olItems(1).Subject
Range("UtläggStart").Offset(0 + nrEM, -1).Value = olItems(1).SenderName
olItems(1).UnRead = False
Set olItems = olInBox.Items.Restrict("[UnRead] = True")
y = y + 1
nrEM = nrEM + 1
Loop
'Application.Calculate
Set olApp = Nothing
Set olNS = Nothing
Set olInBox = Nothing
Set olItems = Nothing
Set olAtt = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
What happens is that with this version it starts to read the mailbox bottom up, so y=1 will be the last (or the oldest unread mail) whereas in all previous versions it has started from the top (or the newest).
I used an override part in one version that could retrieve the desired mail/mails anywhere in the inbox order, so it would be nice to know that some random setting or seomthing dosent alter that.
Anyone have any ideas why?
Also for some reason I couldnt dim Outlook as object, this exact same piece of code on the same computer 15min later didnt work.
Sub SparaUtgifter()Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim Choice As String
Dim olApp As Variant 'Outlook.Application
Dim olNS As Variant 'Outlook.Namespace
Dim olInBox As Variant 'Outlook.MAPIFolder
Dim olItems As Variant 'Outlook.Items
Dim Ans As Long
Dim i As Long
Dim LastRow As Long
Dim parfld As String
Dim subfld As String
Dim strPath As String
Dim strFile As String
Dim rng As Range
Set olApp = CreateObject("Outlook.Application")
Set olNS = olApp.GetNamespace("MAPI")
parfld = Range("InboxUtlägg").Value
Set olInBox = olNS.Folders(parfld)
subfld2 = Range("InboxUtlägg").Offset(0, 1).Value
If Right(subfld2, 1) <> "/" Then subfld2 = subfld2 & "/"
CountSubFldrs = Len(subfld2) - Len(Replace(subfld2, "/", ""))
Do Until CountSubFldrs = 0
If subfld2 = "" Then
Else
subfld = Left(subfld2, InStr(subfld2, "/") - 1)
Set olInBox = olInBox.Folders(subfld)
x = Len(subfld) + 1
subfld2 = Right(subfld2, Len(subfld2) - x)
End If
CountSubFldrs = CountSubFldrs - 1
Loop
'~~> Check if there are any actual unread emails
If olInBox.Items.Restrict("[UnRead] = True").Count = 0 Then
MsgBox "NO Unread Email In Inbox"
Exit Sub
End If
Set olItems = olInBox.Items.Restrict("[UnRead] = True")
x = olItems.Restrict("[UnRead] = True").Count + 1
y = 1
nrEM = 0
Do Until y = x
'paste subject
Range("UtläggStart").Offset(0 + nrEM, 0).Value = olItems(1).Subject
Range("UtläggStart").Offset(0 + nrEM, -1).Value = olItems(1).SenderName
olItems(1).UnRead = False
Set olItems = olInBox.Items.Restrict("[UnRead] = True")
y = y + 1
nrEM = nrEM + 1
Loop
'Application.Calculate
Set olApp = Nothing
Set olNS = Nothing
Set olInBox = Nothing
Set olItems = Nothing
Set olAtt = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub