Here is the complete code:
Option Explicit
dim WshNetwork
dim strServerName
dim strDay, strMonth
dim intSlash1, intSlash2, strNow
Dim objFSO, objMainFolder, objFolders, objFolder, strCurrentDate, objFiles, objFile, strNewFileName, strFolderName, intPos, strCopiedFolder, tmpFolder
Const BGOFolderPrefix = "Optimization"
Const BGOArchiveDir = "\\wsapp0202\d$\xim\"
Set WshNetwork = WScript.CreateObject("WScript.Network"
strServerName = WshNetwork.ComputerName
strNow = now()
intSlash1 = instr(strNow,"/"

intSlash2 = instr(intSlash1 + 1,strNow,"/"

strday = mid(strNow,1,intSlash1 - 1)
If len(strDay) = 1 Then
strDay = "0" & strDay
End If
strmonth = mid(strNow,intSlash1 + 1 ,intSlash2 - intSlash1 - 1)
If len(strMonth) = 1 Then
strMonth = "0" & strMonth
End If
strCurrentDate = Mid(strNow, intSlash2 +1 , 4) & "_" & strMonth & "_" & strDay
strCopiedFolder = ""
Set objFSO = CreateObject("Scripting.FileSystemOBJECT"
If not objFSO.FolderExists(BGOArchiveDir & strServerName) Then
set tmpFolder = objfso.CreateFolder(BGOArchiveDir & strServerName)
End If
Set objMainFolder = objFSO.GetFolder("D:\logmovetest"

Set objFolders = objMainFolder.SubFolders
For Each objFolder In objFolders
If Left(objFolder.Name, Len(BGOFolderPrefix)) = BGOFolderPrefix Then
strFolderName = BGOArchiveDir & strServerName
If Mid(objFolder.Name, Len(BGOFolderPrefix)+1, Len(strCurrentDate)) < strCurrentDate Then
wscript.echo BGOArchiveDir & strServerName & "\"
Call objFolder.Move(BGOArchiveDir & strServerName & "\"

'Call objFolder.Delete
End If
End If
Next
Let me know if you can do anything with it...
Cheers,
Danny