Total Commander

Код: Выделить всё

Option Explicit
' Проверяем число параметров
Dim Title
Title = "Копирование с помощью TC"
If WScript.Arguments.Count < 2 Then
  MsgBox "Неправильно заданы параметры!", _
    vbOKOnly + vbCritical, _
    Title
  WScript.Quit
End If

Dim FSO, OTF, MyFiles, TargetDir 

Set FSO = CreateObject("Scripting.FileSystemObject")
Set OTF = FSO.OpenTextFile(WScript.Arguments(0), 1) 

TargetDir = WScript.Arguments(1)
If Not FSO.FolderExists(TargetDir) Then
  MsgBox "Неправильно задана целевая папка!", _
    vbOKOnly + vbCritical, _
    Title
  Set FSO = Nothing
  WScript.Quit
End If
Do While Not OTF.AtEndOfStream
  MyFiles = OTF.ReadLine
  If Not FSO.FileExists(TargetDir & FSO.GetFile(MyFiles).Name) Then
    FSO.CopyFile MyFiles, TargetDir
  End If
Loop 
Set OTF = Nothing
Set FSO = Nothing
WScript.Quit

Код: Выделить всё

Одако он копирует только файлы.

Код: Выделить всё

Dim FSO, StartFolder, ReadStartFolder, EndFolder, FItem, curFolder

EndFolder= WScript.Arguments(1)
Set FSO = CreateObject("Scripting.FileSystemObject")
Set StartFolder = FSO.OpenTextFile(WScript.Arguments(0), 1)
ReadStartFolder = StartFolder.ReadLine
If Not FSO.FolderExists(EndFolder) Then
FSO.CreateFolder(EndFolder)
End If

If FSO.FolderExists(ReadStartFolder) = False Then
MsgBox "какаято ошибка!", vbCritical
WScript.Quit
End If


Set curFolder = FSO.GetFolder(ReadStartFolder)

For Each FItem In curFolder.SubFolders
   FSO.CopyFile FItem.Path & "\*.*", EndFolder
Next
WScript.Sleep 500
WScript.Quit

Код: Выделить всё

'Копировать структуру выделенных папок и файлов по маске
'с переименованием одинаковых имён по счётчику
'=====================================================
'Условия:
'1. Ключ в файле конфигурации AlwaysCopyInBackground=1
'2. Параметры:  "%T%M" "<Путь назначения>" <маска_расширений>
' Пример: "%T%M" "C:\My Path" *.jpg;*.gif;*.png
'===================================================== 
Dim TCS
Set TCS = CreateObject("TCScript.Helper")
If WScript.Arguments.Count = 0 Then
  MsgBox "Не заданы параметры!", vbOKOnly + vbCritical, "Копирование"
  WScript.Quit
End If
File = WScript.Arguments(0)
TCS.LockTC True
TCS.SetTrgPath(WScript.Arguments(1))
TCS.SendCommand "cm_CopyOtherpanel"
TCS.SendKeystroke "{TAB}"
TCS.SendKeystroke(Trim(WScript.Arguments(2)))
TCS.SendKeystroke "+{TAB 2}{SPACE}{DOWN 4}{ENTER}"
TCS.SetTrgPath(File)
TCS.LockTC False
Set TCS = Nothing
WScript.Quit

Код: Выделить всё

'Копировать структуру выделенных папок и файлов по маске
'с переименованием одинаковых имён по счётчику
'=====================================================
'Условия:
'1. Ключ в файле конфигурации AlwaysCopyInBackground=1
'2. Параметры:  "%T%M" "<Путь назначения>" <маска_расширений>
' Пример: "%T%M" "C:\My Path" *.jpg;*.gif;*.png
'===================================================== 
Dim WSH
Set WSH = CreateObject("WScript.Shell")
If WScript.Arguments.Count = 0 Then
  MsgBox "Не заданы параметры!", vbOKOnly + vbCritical, "Копирование"
  WScript.Quit
End If
File = WScript.Arguments(0)
TCPath = WSH.ExpandEnvironmentStrings("%Commander_Path%") & "\totalcmd.exe"
WSH.Run """" & TCPath & """ /S /O /R=""" & WScript.Arguments(1) & """", 0, True
WSH.SendKeys "{F5}{TAB}"
WSH.SendKeys(Trim(WScript.Arguments(2)))
WSH.SendKeys "+{TAB 2}{ }{DOWN 4}{ENTER}"
WSH.Run """" & TCPath & """ /S /O /R=""" & File & """", 1, True
Set WSH = Nothing
WScript.Quit