SUB folder in outlook inbox

sal21 · Post by **sal21** » 08 Apr 2011, 10:25

In my inbox i have created a new subfolder named SRER hot to set this subfolder admit have:

Set olFld = olNsp.GetDefaultFolder(6)

I have maked this command but the code go in error:

Set olFld = olNsp.GetDefaultFolder(6).Folders("SRER ")

this is a part of my declation:

Code: Select all


Dim olApp As Object
Dim olNsp As Object
Dim olFld As Object
Dim olFld2 As Object
Dim olItm As Object
Dim olAtt As Object
Dim blnStart As Boolean
Dim TEST As Date, DATA_FILE As String
Dim strFilename As String

'http://windowssecrets.com/forums/showthread.php/122163-i-dont-know-is-possible....

On Error Resume Next

Set olApp = GetObject(, "Outlook.Application")
If olApp Is Nothing Then
Set olApp = CreateObject("Outlook.Application")
If olApp Is Nothing Then
MsgBox "OUTLOOK NON APERTO!", vbExclamation
Exit Sub
End If
blnStart = True
End If

On Error GoTo ErrHandler

Set olNsp = olApp.GetNamespace("MAPI")
'Set olFld = olNsp.GetDefaultFolder(6).Folders("SERVIZIO")

Set olFld = olNsp.GetDefaultFolder(6) ' 3 = Inbox

note:
Naturally is a Hans code:-)

Post by **HansV** » 08 Apr 2011, 10:38

You have a space after the folder name. It should be

Set olFld = olNsp.GetDefaultFolder(6).Folders("SRER")

sal21 · Post by **sal21** » 08 Apr 2011, 10:52

HansV wrote:You have a space after the folder name. It should be

Set olFld = olNsp.GetDefaultFolder(6).Folders("SRER")

Eerror always!!!

Code: Select all

Sub ReadEmail()

Dim olApp As Object
Dim olNsp As Object
Dim olFld As Object
Dim olFld2 As Object
Dim olItm As Object
Dim olAtt As Object
Dim blnStart As Boolean
Dim TEST As Date, DATA_FILE As String
Dim strFilename As String

On Error Resume Next

Set olApp = GetObject(, "Outlook.Application")
If olApp Is Nothing Then
Set olApp = CreateObject("Outlook.Application")
If olApp Is Nothing Then
MsgBox "Failed to start Outlook!", vbExclamation
Exit Sub
End If
blnStart = True
End If

On Error GoTo ErrHandler

Set olNsp = olApp.GetNamespace("MAPI")
Set olFld = olNsp.GetDefaultFolder(6).Folders("SRER")

Set olItm = olFld.Items.Find("[SenderName]='gssitaly@iol.it'")

TEST = olItm.ReceivedTime

If olItm Is Nothing Then
MsgBox "Item not found!", vbExclamation
GoTo ExitHandler
End If

If olItm.Attachments.Count = 0 Then
MsgBox "Attachment not found!", vbExclamation
GoTo ExitHandler
End If

Set olAtt = olItm.Attachments.Item(1)
'olAtt.SaveAsFile "C:\TEMP\" & olAtt.Filename
DATA_FILE = Right(Date, 4) & "_" & Mid(Date, 4, 2) & "_" & Left(Date, 2)
strFilename = olAtt.Filename
strFilename = "PLAFOND " & DATA_FILE & ".zip"
olAtt.SaveAsFile "C:\TEMP\" & strFilename

Set olFld2 = olNsp.GetDefaultFolder(6) ' 6 = Deleted Items
olItm.Move olFld2

ExitHandler:
On Error Resume Next
If blnStart Then
olApp.Quit
End If

Exit Sub

ErrHandler:
MsgBox Err.Description, vbExclamation
Resume ExitHandler

End Sub

Post by **HansV** » 08 Apr 2011, 11:05

The line

Set olFld2 = olNsp.GetDefaultFolder(6) ' 6 = Deleted Items

should be

Set olFld2 = olNsp.GetDefaultFolder(3) ' 3 = Deleted Items

Please change the line

On Error Resume Next

to

On Error GoTo 0

temporarily, and note which line is highlighted when the error occurs.

sal21 · Post by **sal21** » 08 Apr 2011, 11:33

HansV wrote:The line

Set olFld2 = olNsp.GetDefaultFolder(6) ' 6 = Deleted Items

should be

Set olFld2 = olNsp.GetDefaultFolder(3) ' 3 = Deleted Items

Please change the line

On Error Resume Next

to

On Error GoTo 0

temporarily, and note which line is highlighted when the error occurs.

Hans... i think now wath is the prob!
The subfolder SRER not is in Inbox folder but in the first root of Set olNsp = olApp.GetNamespace("MAPI")... in this case i dont need to set level (Inbox), or not?

Post by **HansV** » 08 Apr 2011, 11:42

Try

Set olFld = olNsp.GetDefaultFolder(6).Parent.Folders("SRER")

sal21 · Post by **sal21** » 08 Apr 2011, 11:49

HansV wrote:Try

Set olFld = olNsp.GetDefaultFolder(6).Parent.Folders("SRER")

wow!!!!!!!!!!!!!

WORK NOW!
(sorry for mistake)

now prob:-(

In this subfolder SRER are present various email with the sendername 1234@ioi.it

I need to loop all email from this sendename but with the subject "test" and set the newest from the list...
How to?

Post by **HansV** » 08 Apr 2011, 11:55

What do you mean by "set the newest from the list"?

sal21 · Post by **sal21** » 08 Apr 2011, 12:00

HansV wrote:What do you mean by "set the newest from the list"?

When the loop intercept the newest email from the list (with the same object) set it for subseguent code:
Admit have a5 email :

...
10/02/2011
11/01/2002
05/04/2004
...

set the email with the sender date 10/02/2011
....
Set olAtt = olItm.Attachments.Item(1)
'olAtt.SaveAsFile "C:\TEMP\" & olAtt.Filename
DATA_FILE = Right(Date, 4) & "_" & Mid(Date, 4, 2) & "_" & Left(Date, 2)
strFilename = olAtt.Filename
strFilename = "PLAFOND " & DATA_FILE & ".zip"
olAtt.SaveAsFile "C:\TEMP\" & strFilename
.....

Post by **HansV** » 08 Apr 2011, 12:34

Try this:

Code: Select all

Sub ReadEmail()
  Dim olApp As Object
  Dim olNsp As Object
  Dim olFld As Object
  Dim olFld2 As Object
  Dim olItm As Object
  Dim olItms As Object
  Dim olAtt As Object
  Dim blnStart As Boolean
  Dim TEST As Date, DATA_FILE As String
  Dim strFilename As String

  On Error Resume Next

  Set olApp = GetObject(, "Outlook.Application")
  If olApp Is Nothing Then
    Set olApp = CreateObject("Outlook.Application")
    If olApp Is Nothing Then
      MsgBox "Failed to start Outlook!", vbExclamation
      Exit Sub
    End If
    blnStart = True
  End If

  On Error GoTo ErrHandler

  Set olNsp = olApp.GetNamespace("MAPI")
  Set olFld = olNsp.GetDefaultFolder(6).Parent.Folders("SRER")
  Set olItms = olFld.Items.Restrict("[SenderName]='gssitaly@iol.it'")
  If olItms.Count = 0 Then
    MsgBox "Item not found!", vbExclamation
    GoTo ExitHandler
  End If
  olItms.Sort "[ReceivedTime]", True
  Set olItm = olItms.Item(1)

  If olItm.Attachments.Count = 0 Then
    MsgBox "Attachment not found!", vbExclamation
    GoTo ExitHandler
  End If

  Set olAtt = olItm.Attachments.Item(1)
  'olAtt.SaveAsFile "C:\TEMP\" & olAtt.Filename
  DATA_FILE = Format(Date, "yyyy_mm_dd")
  strFilename = olAtt.FileName
  strFilename = "PLAFOND " & DATA_FILE & ".zip"
  olAtt.SaveAsFile "C:\TEMP\" & strFilename

  Set olFld2 = olNsp.GetDefaultFolder(3) ' 3 = Deleted Items
  olItm.Move olFld2

ExitHandler:
  On Error Resume Next
  If blnStart Then
    olApp.Quit
  End If

Exit Sub

ErrHandler:
  MsgBox Err.Description, vbExclamation
  Resume ExitHandler
End Sub

sal21 · Post by **sal21** » 08 Apr 2011, 12:50

HansV wrote:Try this:

Code: Select all

Sub ReadEmail()
  Dim olApp As Object
  Dim olNsp As Object
  Dim olFld As Object
  Dim olFld2 As Object
  Dim olItm As Object
  Dim olItms As Object
  Dim olAtt As Object
  Dim blnStart As Boolean
  Dim TEST As Date, DATA_FILE As String
  Dim strFilename As String

  On Error Resume Next

  Set olApp = GetObject(, "Outlook.Application")
  If olApp Is Nothing Then
    Set olApp = CreateObject("Outlook.Application")
    If olApp Is Nothing Then
      MsgBox "Failed to start Outlook!", vbExclamation
      Exit Sub
    End If
    blnStart = True
  End If

  On Error GoTo ErrHandler

  Set olNsp = olApp.GetNamespace("MAPI")
  Set olFld = olNsp.GetDefaultFolder(6).Parent.Folders("SRER")
  Set olItms = olFld.Items.Restrict("[SenderName]='gssitaly@iol.it'")
  If olItms.Count = 0 Then
    MsgBox "Item not found!", vbExclamation
    GoTo ExitHandler
  End If
  olItms.Sort "[ReceivedTime]", True
  Set olItm = olItms.Item(1)

  If olItm.Attachments.Count = 0 Then
    MsgBox "Attachment not found!", vbExclamation
    GoTo ExitHandler
  End If

  Set olAtt = olItm.Attachments.Item(1)
  'olAtt.SaveAsFile "C:\TEMP\" & olAtt.Filename
  DATA_FILE = Format(Date, "yyyy_mm_dd")
  strFilename = olAtt.FileName
  strFilename = "PLAFOND " & DATA_FILE & ".zip"
  olAtt.SaveAsFile "C:\TEMP\" & strFilename

  Set olFld2 = olNsp.GetDefaultFolder(3) ' 3 = Deleted Items
  olItm.Move olFld2

ExitHandler:
  On Error Resume Next
  If blnStart Then
    olApp.Quit
  End If

Exit Sub

ErrHandler:
  MsgBox Err.Description, vbExclamation
  Resume ExitHandler
End Sub

Naturally the code work great! i need to restrict with other term the loop
But in my old one post i need to loop only the eamil of sender where the subject contain the word "test"....
In effect with the same sender i recive other e mail with different subject but thosse not are important for my app...
I think youo have understand me...

Post by **HansV** » 08 Apr 2011, 13:02

Change

Code: Select all

  Set olItms = olFld.Items.Restrict("[SenderName]='gssitaly@iol.it'")

to

Code: Select all

  Set olItms = olFld.Items.Restrict("[SenderName]='gssitaly@iol.it' AND [Subject]='test'")

sal21 · Post by **sal21** » 08 Apr 2011, 13:20

HansV wrote:Change

Code: Select all

  Set olItms = olFld.Items.Restrict("[SenderName]='gssitaly@iol.it'")

to

Code: Select all

  Set olItms = olFld.Items.Restrict("[SenderName]='gssitaly@iol.it' AND [Subject]='test'")

Set olFld = olNsp.GetDefaultFolder(6).Parent.Folders("SERVIZIO")
Set olItms = olFld.Items.Restrict("[SenderName]='gssitaly@iol.it' AND [Subject]='test')

olItms.Sort "[ReceivedTime]", True
Set olItm = olItms.Item(1)

Error "out of matrice" in:
Set olItm = olItms.Item(1)

peraphs because the subject not is exactlly "test"...
in effect i can have FW:test or r:test ecc...
In this case is possible to set the param of subject with instr(....."test")

Post by **HansV** » 08 Apr 2011, 13:30

It helps if you give us exact information at the start! Change

Code: Select all

  Set olItms = olFld.Items.Restrict("[SenderName]='gssitaly@iol.it' AND [Subject]='test'")

to

Code: Select all

  Set olItms = olFld.Items.Restrict("[SenderName]='gssitaly@iol.it' AND [Subject] Like '*test*'")

By the way, the line

Code: Select all

  Set olItm = olItms.Item(1)

should have been below the following If ... End If.

sal21 · Post by **sal21** » 08 Apr 2011, 19:30

HansV wrote:It helps if you give us exact information at the start! Change
Code: Select all
  Set olItms = olFld.Items.Restrict("[SenderName]='gssitaly@iol.it' AND [Subject]='test'")
to
Code: Select all
  Set olItms = olFld.Items.Restrict("[SenderName]='gssitaly@iol.it' AND [Subject] Like '*test*'")
By the way, the line
Code: Select all
  Set olItm = olItms.Item(1)
should have been below the following If ... End If.

Code go in error "not valid condition" in Set olItms = olFld.Items.Restrict("[SenderName]='gssitaly@iol.it' AND [Subject] Like '*test*'")
....
?????

Post by **HansV** » 08 Apr 2011, 21:53

Sorry, I don't know how to search for the subject of an e-mail.

sal21 · Post by **sal21** » 11 Apr 2011, 10:37

HansV wrote:Sorry, I don't know how to search for the subject of an e-mail.

Perahs resolved with the code:

Code: Select all

Sub ReadEmail()

Dim olApp As Object
Dim olNsp As Object
Dim olFld As Object
Dim olFld2 As Object
Dim olItm As Object
Dim olItms As Object
Dim olAtt As Object
Dim blnStart As Boolean, I As Long
Dim TEST As Date, DATA_FILE As String
Dim strFilename As String, TEMP
Dim CONTA As Long, J As Long
Dim ARRAY_DATE() As Date    'Array DELLE DATE
 Dim ORDINA As String

'http://windowssecrets.com/forums/showthread.php/122163-i-dont-know-is-possible....

On Error Resume Next

Set olApp = GetObject(, "Outlook.Application")
Set olApp = CreateObject("Outlook.Application")

On Error GoTo ErrHandler

Set olNsp = olApp.GetNamespace("MAPI")

CONTA = olNsp.GetDefaultFolder(6).Parent.Folders.Count
For I = 1 To CONTA
    If Trim(olNsp.GetDefaultFolder(6).Parent.Folders(I).Name) = "SERVIZIO" Then
    Exit For
    End If
  Next I

If I > CONTA Then
MsgBox ("SUBFOLDER *** SERVIZIO *** NON TROVATA, IMPOSSIBILE CONTINUARE")
Set olApp = Nothing
Exit Sub
End If

I = 0

Set olFld = olNsp.GetDefaultFolder(6).Parent.Folders("SERVIZIO")
Set olItm = olFld.ItemS.Find("[SenderName]='gssitaly@iol.it' ")

For Each olItm In olFld.ItemS
If InStr(olItm.Subject, "RTI") Then
TEST = olItm.ReceivedTime
ReDim Preserve ARRAY_DATE(I)
ARRAY_DATE(I) = TEST
I = I + 1
End If
Next

For I = UBound(ARRAY_DATE, 1) To LBound(ARRAY_DATE, 1) Step -1
For J = LBound(ARRAY_DATE, 1) To I - 1
If ARRAY_DATE(J) < ARRAY_DATE(J + 1) Then
TEMP = ARRAY_DATE(J)
ARRAY_DATE(J) = ARRAY_DATE(J + 1)
ARRAY_DATE(J + 1) = TEMP
End If
Next J
Next I

For I = UBound(ARRAY_DATE, 1) To LBound(ARRAY_DATE, 1) Step -1
ORDINA = ORDINA & Space(1) & ARRAY_DATE(I)
Next I

TEST = ARRAY_DATE(0)

Set olItm = olFld.ItemS.Restrict("[SenderName]='gssitaly@iol.it' AND [ReceivedTime]='" & TEST & "'")

Set olAtt = olItm.Attachments.Item(1)
DATA_FILE = Right(Date, 4) & "_" & Mid(Date, 4, 2) & "_" & Left(Date, 2)
strFilename = olAtt.Filename
strFilename = "PLAFOND " & DATA_FILE & ".zip"
olAtt.SaveAsFile "C:\TEMP\" & strFilename

Set olFld2 = olNsp.GetDefaultFolder(3)
olItm.Move olFld2

ExitHandler:
On Error GoTo 0
Set olApp = Nothing

Exit Sub

ErrHandler:
Set olApp = Nothing
MsgBox Err.Description, vbExclamation
Resume ExitHandler

End Sub

but go in error:
Set olAtt = olItm.Attachments.Item(1)

Post by **HansV** » 11 Apr 2011, 11:11

You have omitted the test

Code: Select all

  If olItm.Attachments.Count = 0 Then
    MsgBox "Attachment not found!", vbExclamation
    GoTo ExitHandler
  End If

above the line Set olAtt = olItm.Attachments.Item(1).

sal21 · Post by **sal21** » 12 Apr 2011, 09:46

HansV wrote:You have omitted the test
Code: Select all
  If olItm.Attachments.Count = 0 Then
    MsgBox "Attachment not found!", vbExclamation
    GoTo ExitHandler
  End If
above the line Set olAtt = olItm.Attachments.Item(1).

hi friend...
3 days of hard work and not a god result about...
But... i think...

Is possible to fill a combo with a list of email, in Subfolder in discussion, in Ecxel Vba and when the user click on items set the related email and continue with the code to save attachment?
wath you think about tahth? is most simply or not?

Post by **HansV** » 12 Apr 2011, 10:03

Wouldn't it be easier to select the e-mail in Outlook itself and run a macro to save the attachment?

Eileen's Lounge

SUB folder in outlook inbox

SUB folder in outlook inbox

Re: SUB folder in outlook inbox

Re: SUB folder in outlook inbox

Re: SUB folder in outlook inbox

Re: SUB folder in outlook inbox

Re: SUB folder in outlook inbox

Re: SUB folder in outlook inbox

Re: SUB folder in outlook inbox

Re: SUB folder in outlook inbox

Re: SUB folder in outlook inbox

Re: SUB folder in outlook inbox

Re: SUB folder in outlook inbox

Re: SUB folder in outlook inbox

Re: SUB folder in outlook inbox

Re: SUB folder in outlook inbox

Re: SUB folder in outlook inbox

Re: SUB folder in outlook inbox

Re: SUB folder in outlook inbox

Re: SUB folder in outlook inbox

Re: SUB folder in outlook inbox