Submappen aanmaken in outlook met unieke referentie

[Knight75]

Hallo,

Ik probeer in outlook automatisch een hoofdmap met submappen aan te maken, maar de naam van deze submappen moet ook beginnen met de 'unieke' naam van de hoofdmap.

bijv.:

C2101001234
>C2101001234_01_Aanvraag
>C2101001234_02_Offerte
>C2101001234_03_Opdracht
etc.

Nu heb ik wel een macro gevonden voor het aanmaken van de submappen, maar ik wil dus graag het unieke nummer ervoor hebben.

Dus als het mogelijk is eerst via een tekstbox het nummer invullen en dan automatisch de hoofmap en submappen laten aanmaken
Dit is wat ik tot nu toe heb.

Public Sub CreateSubfolders()
  Dim CurrentFolder As Outlook.MAPIFolder
  Dim Subfolder As Outlook.MAPIFolder
  Dim List As New VBA.Collection
  Dim Folders As Outlook.Folders
  Dim Item As Variant
  
  List.Add Array("01_Aanvraag", olFolderInbox)
  List.Add Array("02_Offerte", olFolderInbox)
  List.Add Array("03_Opdracht", olFolderInbox)
   
  Set CurrentFolder = Application.ActiveExplorer.CurrentFolder
  Set Folders = CurrentFolder.Folders
  For Each Item In List
    Folders.Add Item(0), Item(1)
  Next
End Sub

 

[snb]

Codetags ontbreken.

 

[alphamax]

Public Sub CreateSubfolders()

    aSubFolder = Array("01_Aanvraag", "02_Offerte", "03_Opdracht")

    sSubFolder = InputBox("Subfolder")
    
    With Application.ActiveExplorer.CurrentFolder.Folders
        .Add sSubFolder, olFolderInbox
        With .Item(sSubFolder).Folders
            For iaSubFolder = LBound(aSubFolder) To UBound(aSubFolder)
                .Add sSubFolder & "_" & aSubFolder(iaSubFolder), olFolderInbox
            Next
        End With
    End With

End Sub

 

[Knight75]

Public Sub CreateSubfolders()

    aSubFolder = Array("01_Aanvraag", "02_Offerte", "03_Opdracht")

    sSubFolder = InputBox("Subfolder")
    
    With Application.ActiveExplorer.CurrentFolder.Folders
        .Add sSubFolder, olFolderInbox
        With .Item(sSubFolder).Folders
            For iaSubFolder = LBound(aSubFolder) To UBound(aSubFolder)
                .Add sSubFolder & "_" & aSubFolder(iaSubFolder), olFolderInbox
            Next
        End With
    End With

End Sub

@Alphamax, dit is het gewoon!!
Ik ben hier erg blij mee
Dankjewel.

 

[OctaFish]

Nu nog leren om te antwoorden zonder de quote knop te gebruiken .