» Программирование "удобняшек" на VBScript (Часть 2)

Цитата:

мда. описание проблемы на английском
http://www.tutorialsto.com/dotnet/control-and-components/with-regard-to-the-registration-and-license-control-solution-to-the-problem.html

Да, полезная инфа! Как решу вплотную заняться изучением VBS и VBA, обязательно надо будет внести себе в реестр.

[more] Добрый день!
Возникла такая проблема, на озвученный выше скрипт: на Windows 7 32 bit всё запустилось после лицензирования в реестре:

Код: REGEDIT

[HKEY_CLASSES_ROOT\Licenses\4D553650-6ABE-11cf-8ADB-00AA00C00905]
@="gfjmrfkfifkmkfffrlmmgmhmnlulkmfmqkqj"

[HKEY_CLASSES_ROOT\Licenses\78E1BDD1-9941-11cf-9756-00AA00C00908]
@="yjrjvqkjlqqjnqkjvprqsjnjvkuknjpjtoun"

Просьба помочь со скриптом.
На сколько я смог его проверить проблема с командой пинга, он получает ошибку при нормальном соединении и переходит к выполнению перезапуска.
Спасибо.
#

Parazitif

почитай
http://answers.microsoft.com/en-us/windows/forum/windows_7-system/i-got-error-0x8002801c-in-windows-7-register-ocx/471a9b26-88c1-4765-9417-bae27ff8fe3b

Добавлено:

Цитата:

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

мне кажется значение Ping=true
надо присваивать до цикла

For Each objStatus In objPing

иначе в цикле он просто не попадает в выборку по select и всегда получается false.

vadim100

Спасибо, конечно, за ссылку, но только вот оттуда все команды по регистрации и брал. То есть при получении ошибки 0x8002801c на этот майкрософтовский форум и наткнулся..
Забыл указать только, что и файл mswinsck.ocx тоже регистрировал.
Так что другие идеи нужны..

Хм.. Только вот файл mscomm32.ocx я как-то упустил из вида, домой приду - гляну..

Parazitif

при чем здесь команды регистрации, там же главная мысль , что на 64 битах
копировать сами файлы ocx и т.д. надо в каталог c:\windows\sysWOW64 , а не в c:\windows\system32

vadim100

Вы не подскажете как именно изменить скрипт, где нужно присвоить "For Each objStatus In objPing".
Я в программировании ноль, только на чужих примерах.
Спасибо.

Доброго времени суток!Прошу помощи!
Начальство поставило задачу, автоматизировать процесс добавления новых пользователей на терминальные сервера. Их более 50 (серверов), нашел VBSскриптик который добавляет юзверя, проставляет галочки которые мне нужны (запрет смены пароля и срок действия пароля не ограничен) НО , у меня серверов ОООчень много, люди помогите написать скрипт для добавления пользователя на удаленные сервера... ну или намекните куда копать)

Добавлено:
Забыл добавить, AD нету и не планируется...к сожалению.

ysybarite

проверил твой скрипт, всё он отрабатывает отлично.
попробуй в командной строке сделать
ping google.com

возможно у тебя google не пингуется, поэтому скрипт не работает.
если это так поменяй переменную Const UrlPing = "google.com" на то что пингуется.


Добавлено:
IGNAT48

погуглил
http://itband.ru/2009/11/remote-execution/

Все, разобрался, сделал скрипты и запустил на серваках....все работает, единственное добавляет только по 1 пользователю...

Знатоки, нужна помощь. У меня мозг кончился. Следующий скрипт прописан в гпо на выполнение при загрузке компьютера. То есть после входа в профиль пользователя он уже выполняется, но при этом от системной учетки. Итог - при выполнении условий успеха всплывающее сообщение не появляется. Что можно сделать? Запускать при входе пользователя не предлагать, потому что права у него не админские и скрипт выдает "Access is denied".

Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colProcessStopTrace = objWMIService.ExecNotificationQuery _
("SELECT * FROM Win32_ProcessStopTrace")

trigger = 0
Do While trigger = 0
Set objLatestEvent = colProcessStopTrace.NextEvent
If objLatestEvent.ProcessName = "setup.exe" Then
MsgBox "Установка приложения успешно завершена!", 4160, "Проверка готовности установки приложения"
trigger = 1
End If
Loop


Пробовал использовать Popup - та же фигня.

Может быть есть какая-то другая возможность реализовать поиск по завершению нужного процесса без использования objWMIService, чтобы уже тогда встроить скрипт в запуск при входе пользователя?

кто знает можно ли при записи значений в реестр использовать кирилицу?
хочу - LDAPdisplayname = "Компания"
а в реестре получаются кракозябры

'-=-=-=-=-=-=-=-=-=-=-=-=-=-
'Written By James McWhinney
'Vancouver BC, Canada
'www.importfanatik.com
'April 26th, 2006
'-=-=-=-=-=-=-=-=-=-=-=-=-=-

const HKEY_CURRENT_USER = &H80000001
strComputer = "."
Set oReg=GetObject( "winmgmts:{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\default:StdRegProv")
RegistryFolder = "Software\Microsoft\Windows NT\" & _
"CurrentVersion\Windows Messaging Subsystem\Profiles\Outlook\"

LDAPdisplayname = "test"
LDAPserver = "ldap.test.ca"
LDAPport = "389"
LDAPsearchbase = "o=test.ca"


'Add Ldap Type Key
sKeyPath = RegistryFolder & "e8cb48869c395445ade13e3c1c80d154\"
oReg.CreateKey HKEY_CURRENT_USER, sKeyPath
oReg.SetBinaryValue HKEY_CURRENT_USER, _
sKeyPath, "00033009", Array(0,0,0,0)
oReg.SetBinaryValue HKEY_CURRENT_USER, _
sKeyPath, "00033e03", Array(&H23,0,0,0)
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , _
"001e3001", "Microsoft LDAP Directory"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , _
"001e3006", "Microsoft LDAP Directory"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , _
"001e300a", "EMABLT.DLL"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , _
"001e3d09", "EMABLT"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , _
"001e3d13", "{6485D268-C2AC-11D1-AD3E-10A0C911C9C0}"
oReg.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, _
"01023d0c", Array(&H5c,&Hb9,&H3b,&H24, _
&Hff,&H71,&H07,&H41,&Hb7,&Hd8,_
&H3b,&H9c,&Hb6,&H31,&H79,&H92)

'Add Ldap connection settings key
sKeyPath = RegistryFolder & "5cb93b24ff710741b7d83b9cb6317992\"
oReg.CreateKey HKEY_CURRENT_USER, sKeyPath
oReg.SetBinaryValue HKEY_CURRENT_USER, _
sKeyPath, "00033009", Array(&H20,0,0,0)
oReg.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "000b6613", Array(0,0)
oReg.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "000b6615", Array(0,0)
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e3001", LDAPdisplayname
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e3d09", "EMABLT"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e3d0a", "BJABLR.DLL"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e3d0b", "ServiceEntry"
oReg.SetStringValue HKEY_CURRENT_USER, _
sKeyPath , "001e3d13", "{6485D268-C2AC-11D1-AD3E-10A0C911C9C0}"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e6600", LDAPserver
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e6601", LDAPport
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e6602", ""
oReg.SetStringValue HKEY_CURRENT_USER, _
sKeyPath , "001e6603", LDAPsearchbase
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , _
"001e6604", "(&(mail=*)(|(mail=%s*)" & _
"(|(cn=%s*)(|(sn=%s*)(givenName=%s*)))))"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e6605", "SMTP"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e6606", "mail"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e6607", "60"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e6608", "100"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e6609", "120"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e660a", "15"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e660b", ""
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e660c", "OFF"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e660d", "OFF"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e660e", "NONE"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e660f", "OFF"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e6610", "postalAddress"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e6611", "cn"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e6612", "1"
oReg.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "001e67f1", Array(&H0a)
oReg.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "01023615", _
Array(&H50,&Ha7,&H0a,&H61,&H55,&Hde,_
&Hd3,&H11,&H9d,&H60,&H00,_
&Hc0,&H4f,&H4c,&H8e,&Hfa)
oReg.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "01023d01", _
Array(&He8,&Hcb,&H48,&H86,&H9c,&H39,_
&H54,&H45,&Had,&He1,&H3e,&H3c,_
&H1c,&H80,&Hd1,&H54)
oReg.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "01026631", _
Array(&H98,&H17,&H82,&H92,&H5b,&H43,_
&H03,&H4b,&H99,&H5d,&H5c,_
&Hc6,&H74,&H88,&H7b,&H34)
oReg.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "101e3d0f", _
Array(&H02,&H00,&H00,&H00,&H0c,&H00,_
&H00,&H00,&H17,&H00,&H00,&H00,_
&H45,&H4d,&H41,&H42,&H4c,&H54,_
&H2e,&H44,&H4c,&H4c,&H00,&H42,_
&H4a,&H41,&H42,&H4c,&H52,&H2e,_
&H44,&Hc,&H4c,&H00)

'Append to Backup Key for ldap types
sKeyPath = RegistryFolder & "9207f3e0a3b11019908b08002b2a56c2\"
oReg.getBinaryValue HKEY_CURRENT_USER,sKeyPath, "01023d01",Backup
Dim oldLength
oldLength = UBound(Backup)
ReDim Preserve Backup(oldLength+16)
Backup(oldLength+1) = &He8
Backup(oldLength+2) = &Hcb
Backup(oldLength+3) = &H48
Backup(oldLength+4) = &H86
Backup(oldLength+5) = &H9c
Backup(oldLength+6) = &H39
Backup(oldLength+7) = &H54
Backup(oldLength+8) = &H45
Backup(oldLength+9) = &Had
Backup(oldLength+10) = &He1
Backup(oldLength+11) = &H3e
Backup(oldLength+12) = &H3c
Backup(oldLength+13) = &H1c
Backup(oldLength+14) = &H80
Backup(oldLength+15) = &Hd1
Backup(oldLength+16) = &H54
oReg.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "01023d01", Backup


'Append to Backup Key for ldap connection settings
sKeyPath = RegistryFolder & "9207f3e0a3b11019908b08002b2a56c2\"
oReg.getBinaryValue HKEY_CURRENT_USER,sKeyPath, "01023d0e",Backup
oldLength = UBound(Backup)
ReDim Preserve Backup(oldLength+16)
Backup(oldLength+1) = &H5c
Backup(oldLength+2) = &Hb9
Backup(oldLength+3) = &H3b
Backup(oldLength+4) = &H24
Backup(oldLength+5) = &Hff
Backup(oldLength+6) = &H71
Backup(oldLength+7) = &H07
Backup(oldLength+8) = &H41
Backup(oldLength+9) = &Hb7
Backup(oldLength+10) = &Hd8
Backup(oldLength+11) = &H3b
Backup(oldLength+12) = &H9c
Backup(oldLength+13) = &Hb6
Backup(oldLength+14) = &H31
Backup(oldLength+15) = &H79
Backup(oldLength+16) = &H92
oReg.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "01023d0e", Backup


'Delete Active Books List Key
sKeyPath = RegistryFolder & "9375CFF0413111d3B88A001" & _
"04B2A6676\{ED475419-B0D6-11D2-8C3B-00104B2A6676}"
oReg.DeleteKey HKEY_CURRENT_USER, sKeyPath

Никто не может помочь переделать на паскаль unpack.vbs отсюда _http://operafan.net/forum/index.php?topic=20397.msg193677#msg193677

Хочу в текстовом файле, содержащем несколько десятков строк, найти и заменить такую строку
StrOld = "<path recursive="1">PathOld\Content</path>"
на такую
StrNew = "<path recursive="1">PathNew\Content</path>
PathOld и PathNew - это конкретный путь к некоторой папке Content.
Как правильно задать маску для PathOld в StrOld?

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

Цитата:

Небольшая утилита, добавляющая пункт Remove Empty Sub Folders («Удалить пустые подпапки») в контекстное меню проводника. Таким образом, выбрав папку, нажав на ней правой кнопкой и выбрав данный пункт меню, можно очистить ее от всех пустых вложенных папок.
размер: 839 Кб
http://leelusoft.blogspot.ru/2013/04/sub4del-10.html
сборка для флешки (без мусора в инсталяторе): http://rghost.ru/46865382  

Предисловие и отказ от ответственности. Маленькая поделка, написанная мною, под впечатлением от оригинала, на VBScript. Можно использовать безвозмезно, в любых целях. В случае непредвиденных обстоятельств или любых видов убытков, автор претензии не принимает, вы используете это на свой риск.

Функционал. В отличии от оригинала представляет собой нешифрованный скрипт с открытым кодом, таким образом лишенный главного недостатка предка - невозможности самостоятельного улучшения. Встраивается в контекстное меню Проводника пунктом "Чистка папки..". Удаляет все вложенные пустые подпапки, в рекурсивном режиме. Степень вложенности ограничена только мощностями ПК. В отличии от оригинала, также удаляет некоторые типы мусорных файлов. *.bak; *.tmp; *.temp; *.$; *.-; а также содержащие символ “~” в имени или расширении. Перед началом выдает запрос на продолжение. По окончании выдает на экран отчет в виде списка удаленных файлов и папок, и освобожденное место в байтах. Деинсталлятор не предусмотрен, за что прошу больно не пинать. Полностью на русском.Вирусов нет!

Скачать.
http://rghost.ru/47418538


Вышла в свет новая версия Чистка папки (Clean Folder) 1.0.
Список изменений и дополнений:
+ Применен микро-инсталлятор ZipInstaller ( http://www.nirsoft.net/ ), благодаря чему размер установщика уменьшен со 179 Кб до 39 Кб., но при этом улучшена функциональность.
+ Допилена деинсталляция. Удалять программу теперь можно стандартными средствами.
+ Скрипт прописывается в меню не сразу после инсталляции, а только после запуска вручную.
+ Улучшен процесс сканирования, за счет введения безопасного режима сканирования защищенных папок (вроде "xerox" или "microsoft frontpage").
+ Откомментирован код.
+ Улучшен внешний вид отчета.
! Исправлен баг, когда в отчете не отражалось кол-во очищенных килобайт.
! Много мелких изменений и улучшений.

Скачать (39 Кб.)

Приветствую!
Есть скрипт на удаление всех принтаков, которые установлены. НО он почему-то не срабатывает, выдает Access denied
Код: 80041003
Источник: SWbemObjectEx

Что не так???
вот сам скрипт:

strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

Set colInstalledPrinters = objWMIService.ExecQuery _
("Select * from Win32_Printer")

For Each objPrinter in colInstalledPrinters
objPrinter.Delete_
Next

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

Public objFSO
Folder = "c:\papka"
Set objFSO = CreateObject("Scripting.FileSystemObject")

If objFSO.FolderExists(Folder) Then
Call ClrFolder(Folder)
WScript.Echo "Готово."
Else
WScript.Echo "Не найден путь " & Folder
End If
WScript.Quit 0

Function ClrFolder(strFolder)
Dim objFolder, objFile
Set objFolder = objFSO.GetFolder(strFolder)
For Each objFile In objFolder.Files
        if LCase(objFSO.GetExtensionName(File)) = "jpg" or _
        LCase(objFSO.GetExtensionName(File)) = "xls" then
        objFile.Delete TRUE

end if
next
end Function

Не могу понять в чём причина. Написал скрипт, имеющий такие строки:
Set IE = CreateObject("InternetExplorer.Application")
далее цикл, в цикле
if not IE.document.all.Item(String) is nothing then
...
- под XP всё работает, под Win Server 2008 R2 вылетает с ошибкой в этой строке (WSH 5.8), ошибка 800A01A8 ("Требуется объект"). Может VBScript под WSH 5.8 имеет какие-то особенности синтаксиса?

Добавлено:
Всё, разобрался, но меня это ничуть не обрадовало. Действительно, разница диалектов. Под XP, если объект не найден, условие просто не выполняется и без проблем идём к следующей итерации цикла, и дальше всё находится и всё считается. Под R2, если объект не найден, система обнаружения ошибок кричит об этом на всю Ивановскую, и пофигу ей на все эти проверки и условия. Теперь вот ну ничего совершенно не приходит на ум, как же поставить реакцию на несуществование объекта...

Ссылка на мануал умерла... Не подскажете где самую самую базу прочитать ? (математика там, побитовые операции если есть, строки, итд)

Проблема с сохранением


Set oIE = CreateObject("InternetExplorer.Application")
oIE.Navigate "http://...."
Do While oIE.Busy
Loop
oIE.ExecWB 4, 2, "param.txt"

Не хочет автоматически сохранять, вылетает диалоговое окно "Сохранить как..." с предложением сохранить файл param.txt и ждет нажатия кнопки Save.

Добрый день.
Понадобилось мне тут решить вопрос с массовым созданием пользователей в win server 2008 (без AD). По поиску смог найти скрипт на VBS:


Код:
Dim pwFile,compName,userName,userPw,strLine
Dim pwArray
Set objArgs = WScript.Arguments

If objArgs.Count < 2 Then
MsgBox "Usage: " & WScript.ScriptName & " pwfile mashinname"
WScript.Quit
End If
compName=objArgs(1)
pwFile=objArgs(0)
set objSystem = GetObject("WinNT://" & compName)
set objUser = objSystem.Create("user", WinUserAccountName)
Set oFS = CreateObject("Scripting.FileSystemObject")
Set oPws = oFS.OpenTextFile(pwFile)
'go through the password file
Do Until oPws.AtEndOfStream
On Error Resume Next
strLine=oPws.ReadLine
pwArray = Split(strLine," ",-1,1)
userName = pwArray(0)
userPw = pwArray(1)
set objUser = objSystem.Create("user", userName)
objUser.SetPassword userPw
objUser.SetInfo
Loop

132 примера сценариев на языке VBScript и Jscript - pdf

maK
Большое спасибо!

Подскажите как с помощь vbs снять защиту с ячейки листа Excel

попробовал так


Код:
Sheets.Cells(i,1).Locked = False
Sheets.Cells(i,1).FormulaHidden = False

Встал вопрос. Задача распространенная, но нуждаюсь в уточнении...
Имею сервер 2003.
На нем имею скрипт для удаления старых папок и файлов по дате, старше чем n-ое количество дней.
Собственно он:

Код: Option Explicit
Dim FSO, Folder, subFolder
Dim strSource
Dim intErrLevel

strSource = "D:\FTP\Camera\Parking" 'папка содержащая каталоги для проверки
intErrLevel = 0

Set FSO = WScript.CreateObject("Scripting.FileSystemObject")

If FSO.FolderExists(strSource) Then
Set Folder = FSO.GetFolder(strSource)
For Each subFolder In Folder.subFolders
if DateDiff("D", subFolder.DateLastModified, Now) > 2 Then 'количество дней, старше которых будет происходить удаление
subFolder.Delete
End If
Next
Else
WScript.Echo "папка " & strSource & " не найдена."
intErrLevel = 1
End If
Set FSO = Nothing
WScript.Quit intErrLevel

Так второй For Each, что-то вроде такого

Код:
Public Sub DeleteOldDateFolders()
Const baseFolder = "D:\FTP\Camera\"
Dim fso, camFolder, dateFolder
Set fso = CreateObject("Scripting.FileSystemObject")
For Each camFolder In fso.GetFolder(baseFolder).SubFolders
For Each dateFolder In camFolder.SubFolders
If DateDiff("D", dateFolder.DateLastModified, Now) > 2 Then dateFolder.Delete
Next
Next
End Sub

AndVGriваш код вставлять в самый конец моего скрипта? Сори, но я не шарю. Можно подробнее?

Да это в общем готовый скрипт, может потребует каких-то изменений дерево ваших папок.
Const baseFolder = "D:\FTP\Camera\" 'задаёт путь к папке, корневой для папок камер
For Each camFolder In fso.GetFolder(baseFolder).SubFolders
цикл по подпапкам корневой (насколько понял, в корневой находятся подпапки камер)
For Each dateFolder In camFolder.SubFolders
цикл по подпапкам дат для текущей папки камеры, остальное как у вас.

AndVGri

Цитата:

Да это в общем готовый скрипт, может потребует каких-то изменений дерево ваших папок.

Тоесть я создам .txt файлик, скоприрую туда:

Public Sub DeleteOldDateFolders()
Const baseFolder = "D:\FTP\Camera\"
Dim fso, camFolder, dateFolder
Set fso = CreateObject("Scripting.FileSystemObject")
For Each camFolder In fso.GetFolder(baseFolder).SubFolders
For Each dateFolder In camFolder.SubFolders
If DateDiff("D", dateFolder.DateLastModified, Now) > 2 Then dateFolder.Delete
Next
Next
End Sub

Поменяю расширению на .vbs и будет мне счастье?
Пробовал. Не работает.


Цитата:

Const baseFolder = "D:\FTP\Camera\" 'задаёт путь к папке, корневой для папок камер
For Each camFolder In fso.GetFolder(baseFolder).SubFolders
цикл по подпапкам корневой (насколько понял, в корневой находятся подпапки камер)
For Each dateFolder In camFolder.SubFolders
цикл по подпапкам дат для текущей папки камеры, остальное как у вас.

Поняли вы все верно. Есть папка Camera в ней подпапки камер - Parking, External, Internal и др., а в них папки с датами, создаются автоматически и в нимх создаются файлы с записями. Нам нужно, чтобы удалялись именно папки с датами. Папки камер разумеется должны остаться, потому что папки с датами все удалять нельзя, а лишь устаревшие. Таким образом будет постоянная определена глубина архива записей.
Я понимаю что вы написали, но не понимаю именно в какое место вставлять ваш код:

Код: Public Sub DeleteOldDateFolders()
Const baseFolder = "D:\FTP\Camera\"
Dim fso, camFolder, dateFolder
Set fso = CreateObject("Scripting.FileSystemObject")
For Each camFolder In fso.GetFolder(baseFolder).SubFolders
For Each dateFolder In camFolder.SubFolders
If DateDiff("D", dateFolder.DateLastModified, Now) > 2 Then dateFolder.Delete
Next
Next
End Sub

Думаю, что проблема в том, что вы забыли вызвать процедуру, то есть содержимое файла с расширением vbs должно быть

Код:
Option Explicit

DeleteOldDateFolders

Public Sub DeleteOldDateFolders()
Const baseFolder = "D:\FTP\Camera\"
Dim fso, camFolder, dateFolder
Set fso = CreateObject("Scripting.FileSystemObject")
For Each camFolder In fso.GetFolder(baseFolder).SubFolders
For Each dateFolder In camFolder.SubFolders
If DateDiff("d", dateFolder.DateLastModified, Now) > 2 Then dateFolder.Delete
Next
Next
End Sub