Copy Outlook mail (.msg) in windows folder

This code below create a folder for every e-mail that contains attachments. In the folder, we can find the attachments extracted and a word document. I would also like to have inside this folder a copy of the e-mail.

here is my working code below. I just don't know how to copy the e-mail!

Option Explicit

Sub Application_Startup()

Dim ol As Outlook.Application
Dim ns As Outlook.NameSpace
Dim fol As Outlook.Folder
Dim i As Object
Dim mi As Outlook.MailItem
Dim at As Outlook.Attachment
Dim rootfol As Outlook.Folder
Dim fso As Scripting.FileSystemObject
Dim dir As Scripting.Folder
Dim dirName As String

Set fso = New Scripting.FileSystemObject

Set ol = New Outlook.Application
Set ns = ol.GetNamespace("MAPI")
Set rootfol = ns.Folders(1)
Set fol = rootfol.Folders("boîte de réception").Folders("test")

For Each i In fol.Items
        If i.Class = olMail Then
        Set mi = i
        If mi.Attachments.Count > 0 Then

               dirName = "C:\Users\chadi\OneDrive\Documents\VBA\"& Format(mi.ReceivedTime, "yyyy-mm-dd hh-nn-ss ") & Left(Replace(mi.Subject, ":", ""), 20)

              If fso.FolderExists(dirName) Then
              Set dir = fso.GetFolder(dirName)
              Else
              Set dir = fso.CreateFolder(dirName)


          Dim mySpecialWordDocument As String
          mySpecialWordDocument = "C:\Users\chadi\OneDrive\Documents\Scanned Documents\CHADICV.docx"
          fso.CopyFile mySpecialWordDocument, dirName & "\"& Split(mySpecialWordDocument, "\")(UBound(Split(mySpecialWordDocument, "\")))



            End If

                For Each at In mi.Attachments
                at.SaveAsFile dir.Path & "\"& at.FileName


                Next at

                mi.Delete

                End If

        End If

    Next i


End Sub

EDIT :

I just added new lines that copy the email in .msg but it doesnt place it inside the created folder. Any help? this is the code I added :

Dim saveFolder As String
Dim sName As String
saveFolder = dirName
sName = mi.Subject
mi.SaveAs saveFolder & Format$(mi.CreationTime, "yyyymmdd_hhmmss_") & sName & ".msg", olMSG