Страницы: 1
RSS
Application.FileSearch в excel 2007
 
Помогите как справиться с проблемой Application.FileSearch в excel 2007? Макрос не работает из-за этой строчки. возможно ли её заменить другой командой?  
Заранее спасибо.
 
FileSearch в Office 2007 отключена. Используйте Dir и Do...Loop
 
У меня вот такой макрос как переделать его чтобы он заработал в excel 2007?  
With Application.FileSearch  
               .NewSearch  
               .LookIn = PathPrice  
               .SearchSubFolders = True  
               .Filename = "*.DBF"  
               .MatchTextExactly = True  
               If .Execute() > 0 Then  
                   PathPrice = .FoundFiles(1)  
               Else  
                   MsgBox "....."  
                   PathPrice = ""  
               End  
Заранее спасибо.
 
1) Вам обязательно осуществлять поиск по подпапках? Или можно обойтись одной папкой?  
 
2) Какой путь у PathPrice ?
 
1. Могу обойтись наверное и одной, но как ее указать.  
2.Путь к C:\Program Files\1\1
 
Попробуйте  
 
Sub Макрос1()  
Dim PathPrice$, iFileName$, iCount&  
   PathPrice = "C:\Program Files\1\1"  
   If Right(PathPrice, 1) <> "\" Then PathPrice = PathPrice & "\"  
   If Dir(PathPrice, vbDirectory) = "" Then  
       MsgBox "Папка " & PathPrice & " не найдена!", 48, "Ошибка"  
       Exit Sub  
   End If  
   iFileName = Dir(PathPrice & "*.DBF")  
   Do While iFileName <> ""  
       iCount = iCount + 1  
       MsgBox PathPrice & iFileName, , ""  
       iFileName = Dir 'берём следующий файл в папке  
   Loop  
   If iCount = 0 Then MsgBox "Ничего не найдено!", 64, ""  
End Sub
 
А может всеже есть какай нибуть патч запускающий функцию Application.FileSearch?
 
Спасибо, Pavel55!  
То, что нужно! Коротко и эффективно.
 
)) Не за что. Рад, что темы созданные полгода назад кому-то помогают )
 
а всеж-таки как сделать, чтобы и подпапки просматривал..??))
 
А поиск на что? http://www.planetaexcel.ru/forum.php?thread_id=10756
 
http://excelvba.ru/code/FilenamesCollection
 
Sub SearchNewFMS()  
Dim i As Integer, DateInBase As String, FMSDate As String  
path_to_fms = UserForm2.TextBox1.Text  
DateInBase = UserForm2.TextBox2.Text  
'On Error GoTo ends:  
With Application.FileSearch  
   .LookIn = path_to_fms  
   .FileName = "*" & "FMS" & "*.txt"  
   If .Execute(SortBy:=msoSortByFileName, _  
       SortOrder:=msoSortOrderAscending) > 0 Then  
       For i = 1 To .FoundFiles.Count  
           FMSDate = CDbl(Mid(.FoundFiles(i), Len(path_to_fms) + 5, 8))  
           If (FMSDate >= DateInBase) And _  
           (FMSDate < Format(Date, "YYYYMMDD")) Then UserForm2.TextBox3.Text = FMSDate  
       Next i  
   Else  
       MsgBox "Please, select a correct directory with FMS files!"  
   End If  
End With  
End Sub
add
 
ale{}, вы что, читать не умеете?  
с чем вам помочь?  
в теме же всё написано, на что менять FileSearch  
 
 
С использованием моей функции FilenamesCollection, код будет выглядеть так:  
http://excelvba.ru/code/FilenamesCollection  
 
 
Sub SearchNewFMS()  
   Dim i As Integer, DateInBase As String, FMSDate As String  
   path_to_fms = UserForm2.TextBox1.Text  
   DateInBase = UserForm2.TextBox2.Text  
 
   Dim coll As Collection  
   ' считываем в колекцию coll нужные имена файлов  
   Set coll = FilenamesCollection(path_to_fms, "*FMS*.txt")  
 
   If coll.Count = 0 Then MsgBox "Please, select a correct directory with FMS files!": Exit Sub  
 
   For Each Filename In coll ' перебираем все файлы  
       FMSDate = CDbl(Mid(Filename, Len(path_to_fms) + 5, 8))  
       If (FMSDate >= DateInBase) And (FMSDate < Format(Date, "YYYYMMDD")) Then UserForm2.TextBox3.Text = FMSDate  
   Next  
End Sub
Страницы: 1
Читают тему
Наверх