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