Set dictf = CreateObject("Scripting.Dictionary")
dictf.RemoveAll
Set fs1 = CreateObject("Scripting.FileSystemObject")
myname = Dir(pathWithDoc, vbDirectory + vbReadOnly)
mypath = getPathWork() + "\" ' Set the path.
Do While myname <> "" ' Start the loop.
If myname <> "." And myname <> ".." Then
If (GetAttr(pathWithDoc & myname) And vbDirectory) = vbDirectory Then
pos = InStr(myname, EMAI)
If pos > 0 Then
ss = Trim(Mid(myname, pos + 5))
ss = Replace(ss, "_", " ")
dictf.Add ss, myname
End If
End If
End If
myname = Dir ' Get next entry.
Loop
keys = dictf.keys
If dictf.Count > 0 Then
Call runWordApp
Sheets(1).Cells(11, 4).Value = CStr(dictf.Count)
For i = 0 To dictf.Count - 1
myname = dictf.Item(keys(i))
decn = keys(i)
Sheets(1).Cells(12, 4).Value = EMAI + "." + decn
Sheets(1).Cells(11, 4).Value = CStr(i + 1) + " / " + CStr(dictf.Count)
With Application.FileSearch
.NewSearch
.LookIn = pathWithDoc + myname + "\"
.SearchSubFolders = False
.Filename = "*.doc"
ss = Replace(decn, " ", "?")
pattern_files = EMAI + "?" + ss + "*.???"
If .Execute() > 0 Then
For j = 1 To .FoundFiles.Count
Set f = fs1.GetFile(.FoundFiles(j))
If Not (f.name Like pattern_files) Then
ss = f.name
ss = Lat_to_Rus(ss, 4)
If Left(ss, 4) = EMAI Then
nerr = nerr + 1
Print #2, "В папке " + myname + " файл " + f.name + " не соответствует названию папки"
If InStr(f.name, EMAI) = 0 Then
Print #2, f.name + " - возможна латиница среди букв децимального номера!"
End If
End If
End If
Next j
End If
filedoc = pathWithDoc + myname + "\" + myname + ".doc"
If fs1.fileexists(filedoc) = False Then
filedoc = Replace(filedoc, ".doc", ".DOC")
If fs1.fileexists(filedoc) = False Then
.NewSearch
.LookIn = pathWithDoc + myname + "\"
.SearchSubFolders = False
.Filename = MaskForMainDoc(pathWithDoc + myname + "\")
If .Execute() = 1 Then
filedoc = .FoundFiles(1)
Else
filedoc = ""
End If
End If
End If
End With

Тема закрыта администрацией. Причина: нарушение правил форума п.3