Developing.ru

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

Sub Avtomat()
Dim xxStroka, xxStolbec, xxSize, xxSize2, xkkk, i As Integer
Dim xxNameIst, xxS, xFileK, xa, xxBukva, xxK, xxK2, xDate3 As String

ActiveSheet.Unprotect
Application.ScreenUpdating = False

xFileK = "D:\ini\spisok.txt" 'файл формата: "CAZ - 1,2"

   xxStroka = 4
   xxStolbec = 2
   While Worksheets("Лист1").Cells(xxStroka, xxStolbec).Value <> ""
   xxStroka = xxStroka + 1
   Wend
   xkkk = 0
   xDate3 = Format(Date, "yyyy")
   
   
   For i = 4 To xxStroka
   If Worksheets("Лист1").Cells(i, 6).Interior.ColorIndex = 6 Then
   xxNameIst = Right(Cells(i, 5), 7)


   With Application.FileSearch
   .LookIn = "D:\СКАНЫ\" & xDate3 & "\" 'папка с файлами
   .SearchSubFolders = True
   .FileType = msoFileTypeAllFiles
   .FileName = "mv?" & xxNameIst & ".txt"

'вот здесь я понимаю он ищет все вхождения
'а было бы хорошо чтоб он нашел файл и начал уже выполнять операцию с этим вхождением
   If .Execute >= 1 Then
   xa = .FoundFiles(1)
   xxSize = Fix(FileLen(xa) / 1024) + 2
   xxBukva = Mid(xa, Len(xa) - 10, 3)
   Cells(i, 6).Value = xxSize
   Cells(i, 6).Interior.ColorIndex = 0
   xkkk = xkkk + 1
      Open xFileK For Input As #1
      Do While Not EOF(1)
      Line Input #1, xxS
      xxK = LCase(Left(xxS, 3))
      xxSize2 = 0
      If xxBukva = xxK Then
      xxK2 = Right(xxS, 3)
      xxSize2 = Fix(xxSize * xxK2 - xxSize)
      End If
      Loop
      Close #1
   If xxSize2 <> 0 Then
   Cells(i, 7).Value = xxSize2
   Cells(i, 7).Interior.ColorIndex = 0
   End If
   End If
   
   End With

   End If
   Next i
  MsgBox xkkk
  Application.ScreenUpdating = True
End Sub