With the assumption folder name and the word in the subject are the same:


Option Explicit

Private Sub CreateRulesUsingArray()

    Dim colRules As rules
    Dim oRule As Rule
    
    Dim colRuleActions As RuleActions
    Dim oMoveRuleAction As MoveOrCopyRuleAction
    Dim oFromCondition As ToOrFromRuleCondition
    
    Dim oSubjectCondition As TextRuleCondition
    Dim oExceptSubject As TextRuleCondition
    
    Dim oInbox As Folder
    Dim oInboxRuleFolder As Folder
    
    Dim oMoveTarget As Folder
    
    Dim ruleFldrStr As String
    Dim subfolderStr As String
    
    Dim i As Long
    
    Dim subjectFolderArray() As Variant

    subjectFolderArray = Array("hello", "test", "stuff", "important")
    
    'Specify target folder for rule move action
    Set oInbox = Session.GetDefaultFolder(olFolderInbox)
    
    ruleFldrStr = "Folder for move by rule"
    On Error Resume Next
    ' bypass error if folder already exists
    oInbox.Folders.Add (ruleFldrStr)
    ' remove error bypass immediately after purpose is served
    On Error GoTo 0
    
    Set oInboxRuleFolder = oInbox.Folders(ruleFldrStr)
    
    For i = LBound(subjectFolderArray) To UBound(subjectFolderArray)
    
        ' DoEvents is not very useful here
        ' Outlook is unusable when saving rules
        DoEvents
        
        subfolderStr = subjectFolderArray(i)
        Debug.Print subfolderStr
        
        On Error Resume Next
        ' bypass error if subfolder already exists
        oInboxRuleFolder.Folders.Add (subfolderStr)
        ' remove error bypass immediately after purpose is served
        On Error GoTo 0
        Set oMoveTarget = oInboxRuleFolder.Folders(subfolderStr)
        Debug.Print "Folder available: " & oMoveTarget
        
        'Get Rules from Session.DefaultStore object
        Set colRules = Session.DefaultStore.GetRules()
        
        On Error Resume Next
        ' bypass error if rule does not exist
        Debug.Print "Removing: " & subfolderStr & "_rule"
        colRules.Remove (subfolderStr & "_rule")
        ' remove error bypass immediately after purpose is served
        On Error GoTo 0
        
        'Create the rule by adding a Receive Rule to Rules collection
        'Set oRule = colRules.Create("subfolder_rule", olRuleReceive)
        Set oRule = colRules.Create(subfolderStr & "_rule", olRuleReceive)
        
        'Specify the condition for the subject in a TextRuleCondition object
        Set oSubjectCondition = oRule.Conditions.Subject
        With oSubjectCondition
            .Enabled = True
            '.text = Array("hello")
            .text = Array(subfolderStr)
        End With
        
        'Specify the exception condition for the subject in a TextRuleCondition object
        'Exception condition is if the subject contains "fun" or "chat"
        'Set oExceptSubject = oRule.Exceptions.Subject
        'With oExceptSubject
        '    .Enabled = True
        '    .text = Array("fun", "chat")
        'End With
        
        'Specify the action in a MoveOrCopyRuleAction object
        'Action is to move the message to the target folder
        Set oMoveRuleAction = oRule.Actions.moveToFolder
        With oMoveRuleAction
            .Enabled = True
            .Folder = oMoveTarget
        End With
        
        ' DoEvents is not very useful here
        ' Outlook is unusable when saving rules
        DoEvents
        
        'Update the server
        ' Found this had to be done inside the loop
        Debug.Print "Saving: " & subfolderStr & "_rule"
        colRules.Save
        
    Next
        
    Debug.Print "Done " & Now
    
End Sub