Simple move email to different folder

[IonutC]

HI Graham,

I think I solved this. I have this code. Thank you for being there!

Sub SaveMessages() 
    Dim olItems As Outlook.Items
    Dim olItem As Outlook.MailItem
    Dim olFolder As Outlook.Folder
    Dim fName As String
    Dim fPath As String
    fPath = "C:\Data\SR_PIXEL_Error_emails\" 'The folder to save the messages
    CreateFolders fPath 'Create the folder if it doesn't exist
    Set olFolder = Session.PickFolder
    Set olItems = olFolder.Items
    For Each olItem In olItems
        If olItem.Subject Like "*Auto Error Notification for PIXEL Component: Service Request" Then
            SaveUnique olItem, fPath, fName
        End If
    Next olItem
    Set olItem = Nothing
    Set olItems = Nothing
    Set olFolder = Nothing
    lbl_Exit:
    Exit Sub
End Sub

 'An Outlook macro by Graham Mayor - www.gmayor.com
Private Function CreateFolders(strPath As String) 
    Dim strTempPath As String
    Dim lngPath As Long
    Dim vPath As Variant
    Dim oFSO As Object
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    vPath = Split(strPath, "\")
    strPath = vPath(0) & "\"
    For lngPath = 1 To UBound(vPath)
        strPath = strPath & vPath(lngPath) & "\"
        If Not oFSO.FolderExists(strPath) Then MkDir strPath
    Next lngPath
    lbl_Exit:
    Set oFSO = Nothing
    Exit Function
End Function

 'An Outlook macro by Graham Mayor - www.gmayor.com
Private Function SaveUnique(oItem As Object, strPath As String, strFilename As String)  
    Dim lngF As Long
    Dim lngName As Long
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    lngF = 1
    lngName = Len(strFilename)
    Do While fso.FileExists(strPath & strFilename & ".msg") = True
        strFilename = Left(strFilename, lngName) & "(" & lngF & ")"
        lngF = lngF + 1
    Loop
    oItem.SaveAs strPath & strFilename & ".msg"
    lbl_Exit:
    Exit Function
End Function