Option Explicit 
 
Dim FSO, oFile, oFolder, oFolderBox, oSubFolder, strNMonth  
Dim ScPath, ScPathBox 
 
ScPath = left(WScript.ScriptFullName, (Len(WScript.ScriptFullName))-(Len(WScript.ScriptName))- 1 )   
ScPathBox = ScPath & "\box" 
 
Set FSO = CreateObject("Scripting.FileSystemObject")  
Set oFolder = FSO.GetFolder(ScPath)  
Set oFolderBox = FSO.GetFolder(ScPathBox)  
 
For Each oFile In oFolder.Files  
    If UCase(FSO.GetExtensionName(oFile.Path)) = "MSG" Then 
        strNMonth = Right("0" & CStr(Month(oFile.DateLastModified)), 2 ) 
        For Each oSubFolder In oFolderBox.SubFolders  
            If Left(oSubFolder.Name,  2 ) = strNMonth Then _  
                oFile.Move oSubFolder.Path & "\" & oFile.Name  
        Next  
    End If  
Next