DrShark
|
 Posted: Sat Nov 03, 2007 17:29 Post subject: |
 |
|
Из RU.TCKB
| TCKB wrote: | Создание папки с частью имени выделенного файла с последующим перемещением
Q: Требуется создать папку с тем же именем, что имя у выделенного файла, а потом переместить этот файл в эту папку.
A:
'=====================================================================
' Создание папки с частью имени файла, перемещение в нее файла
' Может быть выделено несколько файлов
' В параметрах вызова из TC должно быть прописано:
' %L
'=====================================================================
| Code: | Dim TempFile, FSO, SelFile
Set TempFile =
CreateObject("Scripting.FileSystemObject").OpenTextFile(WScript.Arguments(0), 1)
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim MoveFiles, FileName, FilePath, DashInName, NewFilePath, M1, M2, M3, M4
MoveFiles = ""
Do While Not TempFile.AtEndOfStream
Set SelFile = FSO.GetFile(TempFile.ReadLine)
FileName = SelFile.Name
FilePath = SelFile.ParentFolder
DashInName = InstrRev(FileName, "-")
If DashInName <> 0 Then
NewFilePath = FilePath & "\" & Trim(Left(FileName, DashInName - 1))
If Not FSO.FolderExists(NewFilePath) Then
FSO.CreateFolder(NewFilePath)
End If
If Not FSO.FileExists(NewFilePath & "\" & FileName) Then
FSO.MoveFile SelFile, NewFilePath & "\"
MoveFiles = MoveFiles + FileName & chr(13)
Else
M1 = MsgBox("Уже существует файл " & FileName & " в папке " & NewFilePath, vbOKOnly + vbExclamation, "Внимание!")
End If
Else
M2 = MsgBox("Имя исполнителя не выявлено", vbOKOnly + vbExclamation, "Внимание!")
End If
Loop
If MoveFiles <> "" Then
MoveFiles = Left(MoveFiles, Len(MoveFiles) - 1)
M3 = MsgBox("Перемещены файлы:" & chr(13) & MoveFiles, vbOKOnly + vbInformation, "Результат")
Else
M4 = MsgBox("Ни одного файла не перемещено" & chr(13) & MoveFiles, vbOKOnly + vbExclamation, "Внимание!")
End If
Set TempFile = Nothing
Set FSO = Nothing
Set SelFile = Nothing
Wscript.Quit |
|
И ещё в разделе форума Автоматизация наверняка что-то есть, поищи. |
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
