и не только это ... было бы несколько других дел ... а теперь например это:
Код |
---|
Option Explicit
Sub abc_xyz()
Const pth_src$ = "C:\Temp\0_Source\" ' <== !!! Iskhodnyy katalog
Const pth_trgt$ = "C:\Temp\0_Target\" ' <== !!! Katalog naznacheniya
Const dltr$ = "|" ' Razdelitel'
'Net iskhodnogo kataloga, net raboty !!!
If Dir(pth_src, vbDirectory) = "" Then MsgBox "Net iskhodnoy papki - Konets 'filma'": Exit Sub
'Otsutstvuyet katalog naznacheniya ? Budet sozdan
If Dir(pth_trgt, vbDirectory) = "" Then MkDir pth_trgt
Dim ext$, flnme$, flpth$, fls, i&, ind&, r&: r = 2
Do Until Trim(Cells(r, "A").Value) = ""
flpth = pth_trgt & Trim(Cells(r, "A").Value) & "\"
fls = Split(Application.Trim(Cells(r, "B").Value), dltr, -1, 1)
ind = UBound(fls)
'Otsutstvuyet katalog naznacheniya ? Budet sozdan
If Dir(flpth, vbDirectory) = "" Then MkDir flpth
For i = 0 To ind
'Iskhodnyy fayl sushchestvuyet v iskhodnom kataloge, tak nachinayem rabotat'
If Dir(pth_src & fls(i), vbNormal) <> "" Then
'Fayl uzhe sushchestvuyet v kataloge i meshayet nam ? Delayem kopiyu etoy "meshalki-meshatelya"
If Dir(flpth & fls(i), vbNormal) <> "" Then
ext = Split(fls(i), ".", -1, 1)(UBound(Split(fls(i), ".", -1, 1)))
'Tol'ko odna tochka v imeni fayla, inache budet oshibka !!!
flnme = Split(fls(i), ".", -1, 1)(UBound(Split(fls(i), ".", -1, 1)) - 1)
On Error Resume Next
'Kopiya fayla budet sdelana tol'ko odin raz !!!
Name flpth & fls(i) As flpth & flnme & "_old." & ext
If Err.Number <> 0 Then
MsgBox "Kopii predydushchikh faylov uzhe sushchestvuyut v kataloge !" & vbCrLf & _
"Sdelayte poryadok v svoikh faylakh !" & vbCrLf & "Konets 'filma'"
End
End If
On Error GoTo 0
End If
FileCopy pth_src & fls(i), flpth & fls(i)
End If
Next
r = r + 1
Loop
End Sub
|