Тема: HTA: Копирование новых файлов
Есть скрипт vbs, который копирует измененные с определенной даты и более новые файлы из одной папки в другую. вот он:
' каталог, откуда копируем
InitialFolder = "C:\Documents and Settings\User\Рабочий стол\ActiveX desktop"
' каталог, куда копируем
TargetFolder = "C:\Documents and Settings\User\Рабочий стол\1"
' контрольная дата (копируем файлы с датой создания/изменения позже этой)
ControlDate = CDate("17.11.2012")
On Error Resume Next
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShellApp = CreateObject("Shell.Application")
LogPath = objFSO.GetParentFolderName(WScript.ScriptFullName)
Set LogStream = objFSO.OpenTextFile(LogPath & "\CopyLog.log", 8, True)
LogStream.WriteLine "Начало копирования " & Now()
CopyFiles InitialFolder
LogStream.WriteLine "Конец копирования: " & Now()
LogStream.Close
' процедура рекурсивно перебирает файлы в каталоге
Sub CopyFiles(FolderPath)
On Error Resume Next
Set objFolderItems = objShellApp.NameSpace(FolderPath).Items()
For Each objFolderItem In objFolderItems
If objFolderItem.IsFolder And LCase(Right(objFolderItem.Name, 4)) <> ".zip" Then
CopyFiles objFolderItem.Path
Else
Set objFile = objFSO.GetFile(objFolderItem.Path)
' If objFile.DateCreated > ControlDate Then
If objFile.DateLastModified > ControlDate Then
CopyFile objFolderItem.Path
End If
End If
Next
End Sub
' процедура копирует файл
Sub CopyFile(FilePath)
On Error Resume Next
SubPath = Mid(FilePath, Len(InitialFolder) + 1)
TargetPath = TargetFolder & SubPath
FolderPath = objFSO.GetParentFolderName(TargetPath)
If Not objFSO.FolderExists(FolderPath) Then
CreateFolder FolderPath
End If
' если у файла назначения есть атрибут ReadOnly, снимаем его
If objFSO.FileExists(TargetPath) Then
Set objFile = objFSO.GetFile(TargetPath)
If objFile.Attributes And 1 Then
objFile.Attributes = objFile.Attributes - 1
End If
End If
objFSO.CopyFile FilePath, TargetPath, True
If Err.Number <> 0 Then
LogStream.WriteLine
LogStream.WriteLine FilePath
LogStream.WriteLine Err.Description
LogStream.WriteLine
Err.Clear
Else
LogStream.WriteLine TargetPath
End If
End Sub
' процедура создаёт каталог
Sub CreateFolder (FolderPath)
On Error Resume Next
ParentFolder = objFSO.GetParentFolderName(FolderPath)
If Not objFSO.FolderExists(ParentFolder) Then
CreateFolder ParentFolder
End If
objFSO.CreateFolder FolderPath
End Sub
Но этот скрипт нужно постоянно редактировать чтобы указать другие папки или дату.
По этому захотел переделать его в hta - что бы пути к папкам и дату можно было бы указывать при запуске
Вот что вышло:
<html>
<head>
<meta charset="windows-1251">
<title>Удаление файлов по расширениям</title>
<hta:application id="oHTA"
applicationname="myApp"
border="thin"
borderstyle="normal"
caption="yes"
contextmenu="yes"
icon="webpage.ico"
innerborder="yes"
maximizebutton="no"
minimizebutton="yes"
navigable="no"
scroll="no"
scrollflat="no"
selection="no"
showintaskbar="yes"
singleinstance="yes"
sysmenu="yes"
version="1.0"
windowstate="normal"
/>
<style type="text/css">
body {background:#ddd}
body {font:8pt/10pt Verdana; color:#000}
div.prompt {margin: 5 18}
div.input {text-align:center}
</style>
</head>
<body>
<div class="prompt">
Укажите папку-источник. <br>
Например, C:\Windows
</div>
<div class="input">
<input id="InitialFolder" type="text" size=70>
</div>
<div class="prompt">
Укажите папку для сохранения копии. <br>
Например, D:\Backup
</div>
<div class="input">
<input id="TargetFolder" type="text" size=70>
</div>
<div class="prompt">
Укажите дату изменения файлов. <br>
Например, 15.10.2012
</div>
<div class="input">
<input id="ControlDate" type="text" size=10>
</div>
<br><br>
<div class="input">
<input type="button" value="Синхронизировать" onclick="CopyFiles()">
<input type="button" value="Отмена" onclick="window.close()">
</div>
<script language="VBScript">
'InitialFolder каталог, откуда копируем
'TargetFolder каталог, куда копируем
'ControlDate контрольная дата (копируем файлы с датой изменения позже этой)
On Error Resume Next
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShellApp = CreateObject("Shell.Application")
LogPath = objFSO.GetParentFolderName(WScript.ScriptFullName)
Set LogStream = objFSO.OpenTextFile(LogPath & "\CopyLog.log", 8, True)
LogStream.WriteLine "Начало копирования " & Now()
CopyFiles InitialFolder
LogStream.WriteLine "Конец копирования: " & Now()
LogStream.Close
' процедура рекурсивно перебирает файлы в каталоге
Sub CopyFiles(FolderPath)
On Error Resume Next
Set objFolderItems = objShellApp.NameSpace(FolderPath).Items()
For Each objFolderItem In objFolderItems
If objFolderItem.IsFolder And LCase(Right(objFolderItem.Name, 4)) <> ".zip" Then
CopyFiles objFolderItem.Path
Else
Set objFile = objFSO.GetFile(objFolderItem.Path)
' If objFile.DateCreated > ControlDate Then
If objFile.DateLastModified > ControlDate Then
CopyFile objFolderItem.Path
End If
End If
Next
End Sub
' процедура копирует файл
Sub CopyFile(FilePath)
On Error Resume Next
SubPath = Mid(FilePath, Len(InitialFolder) + 1)
TargetPath = TargetFolder & SubPath
FolderPath = objFSO.GetParentFolderName(TargetPath)
If Not objFSO.FolderExists(FolderPath) Then
CreateFolder FolderPath
End If
' если у файла назначения есть атрибут ReadOnly, снимаем его
If objFSO.FileExists(TargetPath) Then
Set objFile = objFSO.GetFile(TargetPath)
If objFile.Attributes And 1 Then
objFile.Attributes = objFile.Attributes - 1
End If
End If
objFSO.CopyFile FilePath, TargetPath, True
If Err.Number <> 0 Then
LogStream.WriteLine
LogStream.WriteLine FilePath
LogStream.WriteLine Err.Description
LogStream.WriteLine
Err.Clear
Else
LogStream.WriteLine TargetPath
End If
End Sub
' процедура создаёт каталог
Sub CreateFolder (FolderPath)
On Error Resume Next
ParentFolder = objFSO.GetParentFolderName(FolderPath)
If Not objFSO.FolderExists(ParentFolder) Then
CreateFolder ParentFolder
End If
objFSO.CreateFolder FolderPath
End Sub
</script>
</body>
</html>
Никаких ошибок при запуске не выдает, но и не работает
Подскажите, где ошибка.