Question : Outlook select a specific folder using code

I am trying to have a routine that automatically extracts attachments which are scans and saves them to a directory to be processed by my imager.

The attached code works, but on the inbox.  I filter the emails by subject and sender, so I have them all in one folder called Scans.

Can someone help me make this code run only on the "Scans" folder?

Troyo
Code Snippet: 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:

Option Explicit
 
Private Const MAX_PATH = 255
 
Private Declare Function GetTempPath Lib "kernel32" _
Alias "GetTempPathA" (ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
 
Sub detach()
 
 
 
 
Dim oOutlook As Outlook.Application
Dim oNs As Outlook.NameSpace
Dim oFldr As Outlook.MAPIFolder
Dim oMessage As Object
Dim sPathName As String
Dim oAttachment As Outlook.Attachment
Dim iCtr As Integer
Dim iAttachCnt As Integer
Dim PathName
Dim SaveAttachments
 
On Error GoTo ErrHandler
PathName = "X:\Shared\WorkWell\DNA\COC\COCNEW"
 
 
If PathName = "" Then
    sPathName = GetTempDir
Else
    sPathName = PathName
End If
 
If Right(sPathName, 1) <> "\" Then sPathName = sPathName & "\"
If Dir(sPathName, vbDirectory) = "" Then Exit Sub
 
Set oOutlook = New Outlook.Application
Set oNs = oOutlook.GetNamespace("MAPI")
Set oFldr = oNs.GetDefaultFolder(olFolderInbox)
For Each oMessage In oFldr.Items
With oMessage.Attachments
    iAttachCnt = .Count
    If iAttachCnt > 0 Then
        For iCtr = 1 To iAttachCnt
            .Item(iCtr).SaveAsFile sPathName _
                 & .Item(iCtr).FileName
        Next iCtr
    End If
End With
DoEvents
 
Next oMessage
SaveAttachments = True
 
ErrHandler:
Set oMessage = Nothing
Set oFldr = Nothing
Set oNs = Nothing
Set oOutlook = Nothing
End Sub
 
Public Function GetTempDir() As String
 
'from http://www.freevbcode.com/ShowCode.asp?ID=1
    
    Dim sRet As String, lngLen As Long
    
    
    'create buffer
    sRet = String(MAX_PATH, 0)
 
    lngLen = GetTempPath(MAX_PATH, sRet)
    If lngLen = 0 Then Err.Raise Err.LastDllError
    GetTempDir = Left$(sRet, lngLen)
End Function
Open in New Window
Select All

Answer : Outlook select a specific folder using code

Troy,

No need to move it.  I just needed to know where it's at.  Replace line #40 of the code you posted with this

Set oFldr = oNs.GetDefaultFolder(olFolderInbox).Parent.Folders("Scans")
Random Solutions  
 
programming4us programming4us