var fso = new ActiveXObject("Scripting.FileSystemObject");

function SORT_BY_DATE(A , B)
{
    var a = A.match(/[\d\.]+/)[0].replace(/(\d{2})\.(\d{2})\.(\d{4})/, "$3$2$1"),
    b = B.match(/[\d\.]+/)[0].replace(/(\d{2})\.(\d{2})\.(\d{4})/, "$3$2$1");
    return a>b;
}

function FileList(Re)
{
    var Result=[], os = new ActiveXObject("WScript.Shell"), 
    fls = new Enumerator(fso.getFolder(os.CurrentDirectory + "\\").Files);    
    for (;!fls.atEnd();fls.moveNext()) 
    if (Re.test(fls.item())) Result.push(fls.item()+"");
    return Result;
}

Array.prototype.move = function (path)
{
    for (var i=0; i<this.length; i++)
    fso.MoveFile(this[i], path+"\\"+this[i].split("\\").pop());
}

FileList(/сборы/i).sort(SORT_BY_DATE).slice(0,-1).move("Folder");

Xameleon, только на NTFS (там они сортируются в MFT изначально). Но, например, для FAT32:

Ах вон оно как. На FAT не работал, поэтому не ожидал. Тогда стоит загнать весь массив файлов в Recordset и упорядочить. )

Спасибо за информацию.

' VB Script Document
Option Explicit
Dim MonitorDir, OutInfo, OutCoal, OutTax
MonitorDir = "c:\aScripts\vbs\script-coding_01\In\"
OutInfo = "c:\aScripts\vbs\script-coding_01\Out\Информация\"
OutCoal = "c:\aScripts\vbs\script-coding_01\Out\Уголь\"
OutTax = "c:\aScripts\vbs\script-coding_01\Out\Сборы\"

chkFolder OutInfo
chkFolder OutCoal
chkFolder OutTax

Dim tmplInfo, tmplCoal, tmplTax
tmplInfo = "Прочая информация"
tmplCoal = "Информация по углю"
tmplTax = "Сборы на"

Dim dicInfo, dicCoal, dicTax
Set dicInfo = CreateObject("Scripting.Dictionary")
Set dicCoal = CreateObject("Scripting.Dictionary")
Set dicTax = CreateObject("Scripting.Dictionary")

Dim fso, WshShell
Set fso = CreateObject("Scripting.FileSystemObject")
Set WshShell = WScript.CreateObject("WScript.Shell")

Dim folder, file
If fso.FolderExists(MonitorDir) Then
  Set folder = fso.GetFolder(MonitorDir)
 Else
  wscript.echo "Исходный каталог задан неверно!"
  wscript.quit
End If

Dim prefix, data
For Each file In folder.files
 prefix = trim(left(file.name,len(file.name) - 14))
 data = left(trim(right(file.name, 14)),10)
 Select Case prefix
  Case tmplInfo
   dicInfo.add data, file.name
  Case tmplCoal
   dicCoal.add  data, file.name
  Case tmplTax
   dicTax.add  data, file.name
 End Select
Next

Dim arrTMP, i, lastData

If dicInfo.Count > 1 Then  chkFiles dicInfo, OutInfo
If dicCoal.Count > 1 Then chkFiles dicCoal, OutCoal
If dicTax.Count > 1 Then  chkFiles dicTax, OutTax

Set fso = Nothing
Set WshShell = Nothing

Sub chkFiles(Dic, ToDir)
 arrTMP = Dic.Keys
 lastData = vbNullString
 For i = lBound(arrTMP) To uBound(arrTMP)
  If len(lastData) = 0 Then lastData = arrTMP(i) 'первый проход
  If cDate(lastData) < cDate(arrTMP(i)) Then
    fso.GetFile(fso.BuildPath(MonitorDir,Dic.Item(lastData))).Move ToDir
    lastData = arrTMP(i)
   elseif cDate(lastData) > cDate(arrTMP(i)) Then
    fso.GetFile(fso.BuildPath(MonitorDir,Dic.Item(arrTMP(i)))).Move ToDir
  End If
 Next
End Sub

'##############################################################################
'########            проверка-создание дерева каталогов              ##########
'##############################################################################
' 1/2
Dim s_chkPath : s_chkPath = ""
Sub chkFolder(s_path) ' проверка существования файла(логфайла, например)
 Dim s_fso, s_a
 Set s_fso = CreateObject("Scripting.FileSystemObject")
 If Not s_fso.FolderExists(s_path) Then ' если папка не существует
   If StrComp(right(s_path,1),"\") = 0 Then ' папка с пустым именем нам не нужна :)
     s_chkPath = left(s_path, len(s_path) - 1)
    Else
     s_chkPath = s_path
   End If
   ' разбиваем путь на состовляющие
   Dim s_arrFolderPath(), s_regEx, s_Match, s_Matches   ' Create variable.
   Set s_regEx = New RegExp   ' Create regular expression.
   s_regEx.Pattern = "(\\){1}?"   ' Set pattern.
   s_regEx.Global = True   ' Set global applicability.
   Set s_Matches = s_regEx.Execute(s_path)   ' Execute search.
   Redim s_arrFolderPath(s_Matches.count)
   s_chkPath = s_fso.BuildPath (s_chkPath,"")
   wscript.echo "проверяемый путь => " & s_path
   Call MkFldrTree(s_arrFolderPath, s_fso.BuildPath(s_chkPath,""), 0)
 End If
 Set s_a = Nothing
 Set s_fso = Nothing
End Sub
' 2/2
Sub MkFldrTree(Byref s_arr(), s_path2chk, s_fi) ' формирование дерева каталогов
 'wscript.echo fi
 Dim s_fso
 Set s_fso = CreateObject("Scripting.FileSystemObject")
 If s_fso.FolderExists(s_path2chk) Then ' если полученный путь существует...
  If StrComp(s_path2chk, s_chkPath, vbTextCompare) <> 0 Then
    Dim s_fi2
    For s_fi2 = s_fi - 1 To 0 step - 1
     wscript.echo "создаю папку: " & s_path2chk & "\" & s_arr(s_fi2)
     s_fso.CreateFolder s_path2chk & "\" & s_arr(s_fi2)
     s_path2chk = s_path2chk & "\" & s_arr(s_fi2)
    Next
    wscript.echo "done"
  End If
 Else ' если полученный путь НЕ существует...
  wscript.echo s_path2chk & " - не найдена"
  ' укорачиваем путь на один уровень
  s_arr(s_fi) = Right(s_path2chk, Len(s_path2chk)-InStrRev(s_path2chk, "\", -1, vbTextCompare))
  s_path2chk = Left(s_path2chk, InStrRev(s_path2chk, "\", -1, vbTextCompare) - 1)
  s_fi = s_fi + 1
  Call MkFldrTree(s_arr, s_path2chk, s_fi)
 End If
 Set s_fso = Nothing
End Sub
'##############################################################################

Для некоторой универсальности для каждого из трёх типов документов архивная папка файлов задаётся отдельно.
Вывод процесса в лог-файл не делал(рутина, не интересно ).
Если папок архивных не существует, то они будут созданы(в оригинале это была заготовка под текстовый файл, но и с папками жить будет). Правда предполагается, что права на запись в папке содержащей каталог архивных папок у пользователя запускающего скрипт имеются(обработки отказа в доступе нет).
Если исходной папки не существует - сообщение в консоль и завершение работы скрипта.
Подозреваю что при отличной от русской локали(т.е. формат даты не dd.mm.yyyy) сравнение дат будет некорректно - можно и это учесть, просто больше писать прийдётся.

…FileSystemObject всегда возвращает файлы в алфавитном порядке.

Xameleon, только на NTFS (там они сортируются в MFT изначально). Но, например, для FAT32:

╔══════════════════ H:\0056 ═══╤════════╤═════╗
║и         Имя          │Размер│  Дата  │Время║
║..                     │ Вверх│16.03.11│16:51║
║0001                vbs│   154│16.03.11│16:53║
║aaaa                txt│     0│16.03.11│16:52║
║bbbb                txt│     0│16.03.11│16:51║
║                       │      │        │     ║

For Each objFile In WScript.CreateObject("Scripting.FileSystemObject").GetFolder("H:\0056").Files
    WScript.Echo objFile.Name
Next

H:\0056>cscript.exe //nologo 0001.vbs
bbbb.txt
aaaa.txt
0001.vbs

Вот такой вот вариант )

А если составить список всех файлов вида "категория дата.pdf" и переместить все кроме последнего в архивный каталог? Псевдокод:

files = dirlist("Информация по углю*.pdf", SORT_BY_MDATE)
n = files.length - 2
for each i = 0 .. n
    f = files[i]
    f.moveTo(targetDir)
next

Option Explicit

Const ForAppending = 8
Const ForWriting = 2
Dim FileSystemObject
Dim Dictionary
Dim Folder
Dim File
Dim LogFile
Dim PreviousFile
Dim ScriptPath
Dim FullArchivePath

CheckHost

Set Dictionary = CreateObject("Scripting.Dictionary")
'---- настройки
Const FolderPath = "D:\f\test"

Dictionary("") = "D:\f\0"
Dictionary("Информация по углю") = "D:\f\Уголь"
Dictionary("Сборы на") = "D:\f\Сборы"
Dictionary("Прочая информация") = "D:\f\Информация"
'---- настройки

Set FileSystemObject = CreateObject("Scripting.FileSystemObject")

ScriptPath = FileSystemObject.BuildPath(FileSystemObject.GetParentFolderName(WScript.ScriptFullName),"\")

Set Folder = FileSystemObject.GetFolder(FolderPath)

Set LogFile = FileSystemObject.OpenTextFile(ScriptPath & Date & ".txt", ForWriting, True)

For Each File in Folder.Files
    if Not isObject(PreviousFile) Then
        Set PreviousFile = File
    Else
        
        if GetDescription(PreviousFile.Name) = GetDescription(File.Name) Then
            AppendToLog "Найдены однотипные файлы """ & PreviousFile.Name & """ """ & File.Name & """"
            if GetFileDate(File.Name) > GetFileDate(PreviousFile.Name) Then
                FullArchivePath = Dictionary(GetDescription(PreviousFile.Name))
                if FullArchivePath <> "" Then
                    FullArchivePath = FileSystemObject.BuildPath(FullArchivePath,"\")
                    AppendToLog "Перемещаем файл """ & PreviousFile.Name & """ в архивный каталог """ & FullArchivePath & """."
                    If Not FileSystemObject.FolderExists(FullArchivePath) Then RecursiveCreateFolder FullArchivePath
                    PreviousFile.Move FullArchivePath
                Else
                    AppendToLog "Не известен каталог архива для файлов """ & GetDescription(PreviousFile.Name) & """"
                End if
            End if
        End if
        
        Set PreviousFile = File
    End if
Next

Sub RecursiveCreateFolder(ByVal path)
    Dim part, tmpPath
    Path = Replace(Path,"/","\")
    Path = Split(Path,"\")
    For Each Part in Path
        tmpPath = tmpPath & Part & "\"
        If Not FileSystemObject.FolderExists(tmpPath) Then FileSystemObject.CreateFolder(tmpPath)
    Next
End Sub

Function GetDescription(FileName)
    GetDescription = Left(FileName,InstrRev(FileName," ") - 1)
End Function

Function GetFileDate(ByVal FileName)
    Dim SpacePos, DateValue
    FileName = FileSystemObject.GetBaseName(FileName)
    SpacePos = InstrRev(FileName," ")
    if SpacePos > 0 Then
        DateValue = mid(FileName,SpacePos + 1)
        if isDate(DateValue) Then GetFileDate = CDate(DateValue)
    End if
End Function

Sub AppendToLog(Text)
    LogFile.WriteLine Time & ": " & Text 
End Sub

Sub CheckHost()
    if Instr(1,WScript.FullName,"cscript",1) Then
        Dim WshShell
        Set WshShell = CreateObject("WScript.Shell")
        WshShell.Run "wscript.exe """ & WScript.ScriptFullName & """",1,False
        WScript.Quit()
    End if
End Sub

Вот такой вот вариант )

На шаренном диске есть папка "Информация". В ней лежат файлы:

Информация по углю 03.03.2011.pdf
Сборы на 20.02.2011.pdf
Прочая информация 14.03.2011.pdf

В какой-нибудь момент времени юзер записывает туда еще один файл, например положение в папке становится таким:

Информация по углю 03.03.2011.pdf
Информация по углю 03.03.2011.pdf
Сборы на 20.02.2011.pdf
Прочая информация 14.03.2011.pdf

Нужно, чтобы скрипт пробегался по этой папке "Информация" в поисках двух файлов, которые начинают одинаково. Если такие есть, то сравнивал из концовки, то есть даты. И с меньшей датой отправлял в архивную папку. То есть на данном примере он бы перемещал файл Информация по углю 03.03.2011.pdf

Проблема еще состоит в том, что "Информация по углю"  имеет одну архивную папку, "Сборы" - другую и т.д.

1) Только что проверил скрипт. Он из папки folder2 копирует более новые файлы в папку folder1. Сделал

в папке "folder1" файл "Информация по углю 03.03.2011.pdf", а в папке "folder2" файл "Информация по углю 12.03.2011.pdf". При запуске, скрипт успешно заменяет один файл на другой.

2) Предлагаю связаться по icq, т.к я так понял там условия поменялись и теперь есть подкаталоги или как то так ? Либо опишите проблему более доступно с ветвлением. Блок схемы приветствуются )

Информация по углю 03.03.2011.pdf
Информация по углю 12.03.2011.pdf

В папке folder1 пусто. При запуске скрипта выдает мэсседж бокс "Ложь" (я раскомментил строку). В итоге ничего не происходит.
Положил в папку folder1 файлы:

Сборы 01.02.2011
Сборы 11.03.2011

Результат такой:
мэсседж бокс "03.03.2011/01.02.2011" (то есть даты первых файлов в папке folder1 и папки folder2),
мэсседж бокс "12.03.2011/01.02.2011" (первая дата - это второй файл в папке folder2, вторая - первый файл в папке folder1).
И в папке folder1 два файла: Информация по углю 03.03.2011.pdf и Сборы 11.03.2011.pdf

Slav, согласен, и я бы так сделал. Но дело в том, что в эту рабочую папку новые файлы копируют пользователи, причем с iPad'ов, а происходит это не каждый день.

...
В какой-то момент времени (пару раз в неделю) туда складываются новые файлы с такими же именами, но новыми датами (но не обязательно сегодняшними).
В итоге необходим скрипт, который бы запускался, например, каждый день и проверял в этой папке наличие двух файлов с одинаковыми именами, но тот, у которого дата меньше - переносился в архивную папку.
...

holydiver,

я бы пересмотрел сам алгоритм архивирования.

Вы предлагаете:
1. Копировать новые файлы в рабочую папку.
2. С некоторой периодичностью (раз в час, день, месяц, год...) запускать проверку однотипных файлов с разной датой и архивировать все, кроме последнего по дате.

На мой взгляд архивирование надо делать уже на этапе копирования, точнее перед копированием.
Т.е. перед копирование, например, Информация по углю 12.03.2011.pdf в рабочую папку делать что-то типа 
copy Информация по углю*.pdf в архивную папку, а затем del Информация по углю*.pdf из рабочей папки.