Hi,
Thanks a lot.
That not complete but with the start you gave I did this.
Option Explicit
Sub CreateSubFolder()
Dim olNS As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim strName As String
Dim Folders As Outlook.Folders
On Error Resume Next
Set olNS = GetNamespace("MAPI")
Set olFolder = olNS.PickFolder
strName = InputBox("Enter sub-folder name")
If strName = "" Then
MsgBox "No name entered!"
GoTo lbl_Exit
End If
olFolder.Folders.Add strName
Set Folders = olFolder.Folders.Item(strName).Folders
Folders.Add "Doc Contrat", olFolderInbox
Folders.Add "Doc Personel", olFolderInbox
Folders.Add "Remuneration", olFolderInbox
Folders.Add "Visa/Trip", olFolderInbox
Folders.Add "Assurance", olFolderInbox
lbl_Exit:
Set olNS = Nothing
Set olFolder = Nothing
Exit Sub
End Sub
And this does everything I want.
Many thanks.