Looping Subfolders in this code

[Curious Joe]

I have some code I am using to store email information into a SQL
Server table. Everything is working fine except I now need to add the
ability for the macro to loop through any subfolders and append those
emails also.

Sub ExportMailByFolder()
'Export specified fields from each mail
'item in selected folder.
Dim ns As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Set ns = GetNamespace("MAPI")
Set objFolder = ns.PickFolder
Dim adoConn As ADODB.Connection
Dim adoRS As ADODB.Recordset
Dim intCounter As Integer
Dim intCounter2 As Integer
Set adoConn = CreateObject("ADODB.Connection")
Set adoRS = CreateObject("ADODB.Recordset")
'DSN and target file must exist.
'adoConn.Open "DSN=OutlookData;"
adoConn.Open "DSN=Neptune3;"
adoRS.Open "SELECT * FROM email", adoConn, _
adOpenDynamic, adLockOptimistic
'Cycle through selected folder.
For intCounter = objFolder.Items.Count To 1 Step -1
With objFolder.Items(intCounter)
'Copy property value to corresponding fields
'in target file.
If .Class = olMail Then
adoRS.AddNew
adoRS("Subject") = .Subject
adoRS("Body") = .Body
adoRS("FromName") = .SenderName
adoRS("ToName") = .To
adoRS("FromAddress") = .SenderEmailAddress
adoRS("FromType") = .SenderEmailType
adoRS("CCName") = .CC
adoRS("BCCName") = .BCC
adoRS("Importance") = .Importance
adoRS("Sensitivity") = .Sensitivity

If .Attachments.Count >= 1 Then
Set myAttachments = .Attachments
Dim myAttStr As String
For intCounter2 = myAttachments.Count To 1 Step -1
If
Replace(Replace(myAttachments.Item(intCounter2).DisplayName, ":", ""),
"/", "") <> "" Then
myAttachments.Item(intCounter2).SaveAsFile "j:\client\cvs
\emailattachments\" &
Replace(Replace(myAttachments.Item(intCounter2).DisplayName, ":", ""),
"/", "")
myAttStr = myAttStr & " " &
Replace(Replace(myAttachments.Item(intCounter2).DisplayName, ":", ""),
"/", "")
End If
Next
End If
adoRS("AttachmentList") = myAttStr
myAttStr = ""
adoRS.Update
End If
End With
Next
adoRS.Close
Set adoRS = Nothing
Set adoConn = Nothing
Set ns = Nothing
Set objFolder = Nothing
End Sub


Any help is appreciated,

CJ

 

[Dmitry Streblechenko]

Move the code processing the folder to a separate sub and make it take the
foler as a parameter.
Call that sub after calling PickFolder.
In the new sub loop through all subfolders in the MAPIFolder.Folders
collection and call thatrnwe sub again recursively.

--
Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool
-

 

[Sue Mosher [MVP-Outlook]]

For an code sample of such basic folder iteration, see http://www.outlookcode.com/codedetail.aspx?id=628