Dim oFSO, oFolder, oFile
Dim i, j, MyPath, FCnt, Min, PoTemp, sTmp, sL, sR, Usl
With CreateObject("Word.Application")
.Visible = True
With .FileDialog(4)
.ButtonName = "Выбрать": .Title = Title: .InitialFileName = "C:\"
Usl = (.Show = -1)
If Usl Then
MyPath = .SelectedItems(1)
End If
End With
.Quit
End With
If Usl Then
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(MyPath)
MyPath = MyPath & "\"
FCnt = oFolder.Files.Count
ReDim OldNames(FCnt), NewNames(FCnt), Poryadok(FCnt), NewPrefix(FCnt)
i = 0
For Each oFile In oFolder.Files
i = i + 1
OldNames(i) = oFile.Name
If Len(OldNames(i)) > 5 Then
sTmp = Left(OldNames(i), 5)
sR = Right(OldNames(i), Len(OldNames(i)) - 5)
Usl = False
sL = ""
For j = 1 To 5
PoTemp = Mid(sTmp, j, 1)
Select Case PoTemp
Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"
If j = 2 Then
Usl = True
End If
Case "_", " "
If Not Usl Then
sL = sL & PoTemp
End If
Case Else
sL = sL & PoTemp
End Select
Next
NewNames(i) = sL & sR
Else
NewNames(i) = OldNames(i)
End If
Poryadok(i) = Rnd
sTmp = Trim(CStr(i))
j = Len(sTmp)
If j < 4 Then
sTmp = String(4 - j, "0") & sTmp
End If
NewPrefix(i) = sTmp & "_"
Next
Randomize Timer
For i = 1 To FCnt
Min = Poryadok(i)
For j = i + 1 To FCnt
If Min > Poryadok(j) Then
PoTemp = Poryadok(i)
Poryadok(i) = Poryadok(j)
Poryadok(j) = PoTemp
sTmp = NewPrefix(i)
NewPrefix(i) = NewPrefix(j)
NewPrefix(j) = sTmp
End If
Next
Next
For i = 1 To FCnt
NewNames(i) = MyPath & NewPrefix(i) & NewNames(i)
oFSO.GetFile(MyPath & OldNames(i)).Move NewNames(i)
Next
Set File = Nothing
Set oFolder = Nothing
Set oFSO = Nothing
End If