Sub ListFolders(ByVal objParentFolder As Outlook.MAPIFolder)
        Dim objFoldersColl As Outlook.Folders 
        Dim objOneSubfolder As Outlook.MAPIFolder 

        If Not objParentFolder Is Nothing Then
            If objParentFolder.Name = "Моя папка" Then
                ' Типа здесь нужно добавить
                 exit sub
            End If

            objFoldersColl = objParentFolder.Folders
            If Not objFoldersColl Is Nothing Then 
                objOneSubfolder = objFoldersColl.GetFirst
                While Not objOneSubfolder Is Nothing 
                    ListFolders(objOneSubfolder) 
                    objOneSubfolder = objFoldersColl.GetNext
                End While
            End If
            Exit Sub
        End If
    End Sub

objParentFolder.Items.Add(...)