Страница: 1 | 2 | 3 |
|
Вопрос: Нужна помощь в написании скрипта VBS
|
Добавлено: 21.03.11 00:47
|
|
Автор вопроса: Влерий
|
Нужен скрипт который будет осуществлять поиск файлов с расширениями *.doc *.docx *.txt по заданному пути(ям) (имя файлов любое)
И что бы копировал найденные файлы в указанную папку
и записывал пути файлов в файл *.txt
Нашел в интерне кое что но не знаю как правильно изменить и довести его до ума...
Set FSO = CreateObject("Scripting.FileSystemObject")
Set TF = FSO.copyfolder("xxx")
Const FOR_READING = 1
strFolder = "yyy"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strFolder)
TF.Write objFolder.Path
TF.Write vbcrlf
Set colFiles = objFolder.Files
For Each objFile In colFiles
TF.Write objFile.Path
TF.Write vbcrlf
Next
ShowSubFolders(objFolder)
Sub ShowSubFolders(objFolder)
Set colFolders = objFolder.SubFolders
For Each objSubFolder In colFolders
TF.Write objSubFolder.Path
TF.Write vbcrlf
Set colFiles = objSubFolder.Files
For Each objFile In colFiles
TF.Write objFile.Path
TF.Write vbcrlf
Next
ShowSubFolders(objSubFolder)
Next
End Sub
Если есть возможность то киньте ответ на i.am.lion@yandex.ru
Буду благодарен
Заранее спасибо!
Ответить
|
Номер ответа: 1 Автор ответа: Just
Вопросов: 4 Ответов: 330
|
Профиль | | #1
|
Добавлено: 21.03.11 14:46
|
' Копирование, удаление файлов.vbs
-
- Option Explicit
- On Error Resume Next
- Dim objFSO, sLog, sPath, sDestPath, sExt, bLog, bCopy, bDel, bAskDel
-
-
- bLog = True
- bCopy = True
- bDel = False
- bAskDel = True
- sExt = LCase("doc,docx,txt")
-
-
- sPath = InputBox("Укажите папку!", "Копирование, удаление файлов", "C:\Documents and Settings")
- If sPath = "" Then WScript.quit
-
- sDestPath = Left(WScript.ScriptFullName, (Len(WScript.ScriptFullName)) - (Len(WScript.ScriptName)))
- sDestPath = sDestPath & sExt & "\"
-
-
-
-
- WScript.Echo ("Поиск...")
- Set objFSO = CreateObject("Scripting.FileSystemObject")
- If objFSO.FolderExists(sDestPath) = 0 Then objFSO.CreateFolder sDestPath
- FindInFolder (sPath)
- FindInSubFolders (sPath)
- If bLog Then
- if sLog <> "" then
- Dim objFileLog, sLogPath
- sLogPath = Left(WScript.ScriptName, (Len(WScript.ScriptName) - 4)) & "_(" & DatePart("d", Date) & "." & DatePart("m", Date) & "." & DatePart("yyyy", Date) & ")." & "log"
- Set objFileLog = objFSO.OpenTextFile(sLogPath, 2, True)
- sLog = Mid(sLog, 1, Len(sLog) - 2)
- objFileLog.Write sLog
- objFileLog.Close
- Set objFileLog = Nothing
- End If
- End If
- Set objFSO = Nothing
- WScript.Echo ("Поиск завершен!")
- WScript.quit
-
-
-
-
- Sub FindInSubFolders(folderspec)
- On Error Resume Next
- Dim f, f1, sf
- Set f = objFSO.GetFolder(folderspec)
- Set sf = f.SubFolders
- For Each f1 In sf
- FindInFolder (f1.Path)
- FindInSubFolders (f1.Path)
- Next
- End Sub
-
-
- Sub FindInFolder(folderspec)
- On Error Resume Next
- Dim f, f1, fc, ext, s, i, ExtensionArray, ArrayLine, ArrayCount, RetDel
- Set f = objFSO.GetFolder(folderspec)
- Set fc = f.Files
-
- If sExt <> "" Then
- ExtensionArray = Split(sExt, ",")
- ArrayLine = UBound(ExtensionArray)
- End If
-
-
- For Each f1 In fc
-
- If sExt = "" Then
-
- If bLog Then sLog = sLog & f1.Path & vbCrLf
- If bCopy Then objFSO.CopyFile f1.Path, sDestPath
- If bDel Then
- If bAskDel Then
- RetDel = MsgBox(f1.Path, 4 + 32, "Удалить файл?")
- If RetDel = 6 Then objFSO.DeleteFile (f1.Path)
- Else
- objFSO.DeleteFile (f1.Path)
- End If
- End If
-
- Else
-
- ext = LCase(objFSO.GetExtensionName(f1.Path))
- s = LCase(f1.Name)
-
- For ArrayCount = 0 To ArrayLine
-
- If (ext = Trim(ExtensionArray(ArrayCount))) Then
- If bLog Then sLog = sLog & f1.Path & vbCrLf
- If bCopy Then objFSO.CopyFile f1.Path, sDestPath
- If bDel Then
- If bAskDel Then
- RetDel = MsgBox(f1.Path, 4 + 32, "Удалить файл?")
- If RetDel = 6 Then objFSO.DeleteFile (f1.Path)
- Else
- objFSO.DeleteFile (f1.Path)
- End If
- End If
- Exit For
- End If
- Next
-
- End If
-
- Next
- End Sub
Ответить
|
Страница: 1 | 2 | 3 |
Поиск по форуму