Поиск файла до первого вхождения?

[Rossoman]

Как бы мне оптимизировать работу макроса, ну чтоб он как-нибудь побыстрее искал файл по маске...или до первого вхождения...

Что можете посоветовать? Так как файл нужно найти и сразу начать выполнять поставленные задачи. И что вообще делается в вба, для быстрого поиска файла.


Прелюдия:
Открыт отчет, заполненный ячейками, макрос ищет выделенную желтым ячейку с размером, если находит файл .FileName = "bb?" & xxNameIst & ".txt", который составляется из столбца левее(желтой ячейки)
If Worksheets("Лист1").Cells(i, 6).Interior.ColorIndex = 6 Then
xxNameIst = Right(Cells(i, 5), 7)
то он считывает размер файла, записывает его в эту ячейку, и снимает желтый... ну там еще один ньюанс с xFileK, но это можно опустить, это еще одна проверка.

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 = "bb?" & 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

[SAS888]

1. Метод FileSearch лучше не использовать, ибо разработчики "Microsoft" от него отказались. Для поиска требуемого файла используйте цикл Do...Loop.
2. Для записи данных в txt файл очень часто более рационально использовать метод Write (WriteLine) объекта TextStream из FileSystemObject.
3. Прикрепите файл с исходными данными и подробно опишите задачу, что требуется сделать. В таком случае, Вы получите более правильный ответ, нежели восстанавливать задачу, разбирая Ваш код.

[Rossoman]

[стер сообщение]