Directory creation problem

[RonQA]

The code below is for Outlook. It takes a highlighted email and copies it to a directory on our network. If the directory does not exist it creates it and copies the email to it.

The problem is that the directory it creates cannot be deleted by windows. I have to use a program called Unlocker to delete it.

Can anyone see where I have gone wrong ?

Sub Projects()
Dim olApp As Outlook.Application
Dim myOlExp As Explorer
Dim myOlSel As Selection
Dim myOlMail As MailItem
Dim i As Integer, j As Long
Dim FilepathRoot As String
Dim strname As String


Set olApp = Outlook.Application
Set myOlExp = ActiveExplorer
Set myOlSel = myOlExp.Selection


'====Get selected email

For j = 1 To myOlSel.Count
Set myOlMail = myOlSel.Item(j)
Next

strname = myOlMail.Subject
Trim (strname)

FilepathRoot = "O:\SOP Forms\Quality Assurance\Projects\" & strname & "\"
Trim (FilepathRoot)

If Len(Dir(FilepathRoot, vbDirectory)) = 0 Then


MkDir (FilepathRoot)

End If

myOlMail.SaveAs FilepathRoot & strname & ".msg", olMSG

End Sub

Thanks....