Create and rename directory name based on the values from the Excel sheet table. Use Excel's Visual Basic for Applications (VBA).

DirectoryExport.vb

Private Sub ExportSelected_Click()
    
    Dim CWS As Worksheet
    Set CWS = ActiveSheet
    
    ' Fields whose values are used when generating the exported directory name
    Dim FieldNames
    FieldNames = Array("Start date", _
                       "Customer", _
                       "Agent", _
                       "Project Name or description")

    ' Names of the subdirectories beneath the exported directory
    Dim SubDirNames
    SubDirNames = Array("1.0 Correspondence", _
                        "1.1 Request, Tender documents etc", _
                        "1.2 Calculation", _
                        "1.3 Quotation Customer", _
                        "1.4 Order Confirmation", _
                        "2.1 Transfer Sales aan Projectmanager")
    
    ' Check: selected cell cannot be empty
    If IsEmpty(Cells(ActiveCell.Row, ActiveCell.Column).Value) Then
        MsgBox "Selected cell is empty."
        End ' Return from the subroutine
    End If
    
    ' Check: selected element cannot be a field title
    Set FieldRows = CreateObject("System.Collections.ArrayList")
    Set FieldColums = CreateObject("System.Collections.ArrayList")
    Dim k
    For k = LBound(FieldNames) To UBound(FieldNames)
        Set CurrentField = CWS.Cells.Find(what:=FieldNames(k), lookat:=xlWhole, LookIn:=xlValues)
        If Not CurrentField Is Nothing Then
            FieldRows.Add CurrentField.Row
            FieldColums.Add CurrentField.Column
        End If
    Next k
    
    If FieldRows.contains(ActiveCell.Row) Then
        MsgBox "Cannot select row with field names:" & vbCrLf & Join(FieldNames, vbCrLf) & vbCrLf & vbCrLf & _
                "Choose one of their data cell from the rows below."
        End
    End If
    
    If Not FieldColums.contains(ActiveCell.Column) Then
        MsgBox "Cannot select cells that do not belong to:" & vbCrLf & Join(FieldNames, vbCrLf) & vbCrLf & vbCrLf & _
                "Choose data cell corresponding to one of the listed fields."
        End
    End If
            
    Dim DirName As String
        
    Set EmptyColumns = CreateObject("System.Collections.ArrayList")
        
    Dim i
    For i = 0 To UBound(FieldNames)
        
        Set CurrentField = CWS.Cells.Find(what:=FieldNames(i), lookat:=xlWhole, LookIn:=xlValues)
        
        If CurrentField Is Nothing Then
            
            EmptyColumns.Add CurrentField.Column ' field was not found
            
        Else
            
            If IsEmpty(Cells(ActiveCell.Row, CurrentField.Column).Value) Then
                
                EmptyColumns.Add CurrentField.Column 'cell of the field was empty
                    
            Else
                
                DirName = DirName & Cells(ActiveCell.Row, CurrentField.Column).Value
                    
                If i < UBound(FieldNames) Then
                    If i > 0 Then
                        DirName = DirName & " - "
                    Else
                        DirName = DirName & " "
                    End If
                End If
                    
            End If
            
        End If
            
    Next i
    
    
    If EmptyColumns.Count > 0 Then
                    
        Dim FoundEmptyMessage As String
        
        FoundEmptyMessage = "Found " & EmptyColumns.Count & " empty cell(s) in selected row " & ActiveCell.Row & " and column(s):" & vbCrLf
        
        Dim EmptyColumnsItem As Variant
        
        For Each EmptyColumnsItem In EmptyColumns
            FoundEmptyMessage = FoundEmptyMessage & Split(Cells(1, EmptyColumnsItem).Address, "$")(1) & ", "
        Next
        
        MsgBox FoundEmptyMessage
                    
    Else
            
        Dim OutRootDir As String
                
        OutRootDir = ActiveWorkbook.Path
                
        OutDir = OutRootDir & "\" & DirName
                    
        CreateDirectory (OutDir)
                    
        Dim j
        For j = 0 To UBound(SubDirNames)
            CreateDirectory (OutDir & "\" & SubDirNames(j))
        Next j
            
        MsgBox "Created" & vbCrLf & DirName & vbCrLf & _
                "in" & vbCrLf & OutRootDir & vbCrLf & _
                "with subdirectories:" & vbCrLf & Join(SubDirNames, vbCrLf)
                    
    End If
        
End Sub

' Call for the deactivated button - export all at once, without selecting cell
Private Sub Export_Click()
    
    Dim CWS As Worksheet
    
    Dim Cell As Range
    Dim Cell1 As Range
    
    Dim DirName As String
    Dim OutRootDir As String
    
    Dim FieldNames
    FieldNames = Array("Start date", _
                       "Customer", _
                       "Agent", _
                       "Project Name or description")
    
    Dim SubDirNames
    SubDirNames = Array("1.0 Correspondence", _
                        "1.1 Request, Tender documents etc", _
                        "1.2 Calculation", _
                        "1.3 Quotation Customer", _
                        "1.4 Order Confirmation", _
                        "2.1 Transfer Sales aan Projectmanager")
    
    Set CWS = ActiveSheet
    
    OutRootDir = ActiveWorkbook.Path
    
    If Len(Dir(ActiveWorkbook.Path, vbDirectory)) = 0 Then
        OutRootDir = GetDesktop() ' Default directory if not found
    End If

    Set CellRoot = CWS.Cells.Find(what:=FieldNames(0), lookat:=xlWhole, LookIn:=xlValues)
    
    If Not CellRoot Is Nothing Then
        
        For lRow = CellRoot.Row + 1 To CellRoot.Row + 1 + 100
        
            If Not IsEmpty(Cells(lRow, CellRoot.Column).Value) Then
                
                DirName = Cells(lRow, CellRoot.Column).Value
                
                Dim CountEmpty As Integer
                CountEmpty = 0
            
                Dim i
                For i = 1 To UBound(FieldNames)
                    
                    Set Cell = CWS.Cells.Find(what:=FieldNames(i), lookat:=xlWhole, LookIn:=xlValues)
                
                    If Not Cell Is Nothing Then
                        
                        If IsEmpty(Cells(lRow, Cell.Column).Value) Then
                            CountEmpty = CountEmpty + 1
                        Else
                            If i > 1 Then
                                DirName = DirName & " - "
                            Else
                                DirName = DirName & " "
                            End If
                            
                            DirName = DirName & Cells(lRow, Cell.Column).Value
                            
                        End If
                        
                    End If
                
                Next i
                
                If CountEmpty = UBound(FieldNames) Then
                    
                    Debug.Print "all other fields were empty"
                    
                    Exit For 'Exited when all fields are empty
                
                ElseIf CountEmpty > 0 Then
                    
                    Debug.Print "skipping directory due to incomplete fields"
                
                Else
                    OutDir = OutRootDir & "\" & DirName
                    
                    CreateDirectory (OutDir)
                    
                    Dim j
                    For j = 0 To UBound(SubDirNames)
                        CreateDirectory (OutDir & "\" & SubDirNames(j))
                    Next j
                    
                End If
                
            End If
        
        Next lRow
        
        MsgBox "Done, directories exported to " & OutRootDir
    
    End If
    
End Sub

Function GetDesktop() As String
    Dim oWSHShell As Object
    Set oWSHShell = CreateObject("WScript.Shell")
    GetDesktop = oWSHShell.SpecialFolders("Desktop")
    Set oWSHShell = Nothing
End Function

Function CreateDirectory(DirPath As String) As Boolean
    If Len(Dir(DirPath, vbDirectory)) = 0 Then
        MkDir (DirPath)
        On Error Resume Next
    End If
End Function