Saludos a todos,
Tengo un serio inconveniente que no he podido solucionar. Estoy
intentando buscar la ruta de los archivos que contengan un texto
especificado por el usuario. Utilizó tres celdas de excel
(TEXTOBUSCAR, RUTABUSCAR, ARCHIVOBUSCAR) y un boton de comandos
(BtnBuscar) . En estas tres casillas se puede incorporar la siguiente
información:
- El texto a buscar, la ruta en la cual se desea buscar y el archivo a
buscar.
El caso es el siguiente, Cuando pretendo hacer una busqueda (indicando
solo el texto a buscar, ya que el resto de info puede ser la por
defecto), en esta linea "If .Execute() > 0 Then" me produce error.
Si alguien sabe que ocurre le agradezco me comente como solucionarlo.
La version de Office es 97 y el SO es W2000 SP4. Algo curioso es que
este codigo funciono unas veces pero de un momento a otro se daño.
He probado este codigo en versiones de Office superiores y corre a la
perfección.
Aqui les dejo el codigo, gracias de antemano.
Salu2
Luis Vicente Gutierrez Padilla
Santa Marta - Colombia
Private Sub BtnBuscar_Click()
On Error GoTo Err:
If Len(Range("TEXTOBUSCAR")) > 0 Then
TxtoBscar = Range("TEXTOBUSCAR").Value
Else
Err.Raise 59900, "Función Buscar", "El texto a buscar no puede
ser vacio."
End If
Dim VectorArchivos(100) As String
pos = 0
With Application.FileSearch
.NewSearch
.LookIn = IIf(Len(Range("RUTABUSCAR")) > 0,
Range("RUTABUSCAR"), "C:\Varios\")
.SearchSubFolders = True
.FileName = IIf(Len(Range("ARCHIVOBUSCAR")) > 0,
Range("ARCHIVOBUSCAR"), "Detalle*")
.MatchTextExactly = False
.FileType = msoFileTypeAllFiles
sw = False
If .Execute() > 0 Then
MsgBox "Se realizará la busqueda en " & .FoundFiles.Count
& " archivos."
For i = 1 To .FoundFiles.Count
Workbooks.Open (.FoundFiles(i))
Workbooks(ExtractFileName(.FoundFiles(i))).Activate
Worksheets(1).Select
Set celda Worksheets(1).Range("A1:DA1000").Find(TxtoBscar)
If Not celda Is Nothing Then
VectorArchivos(pos) = .FoundFiles(i)
pos = pos + 1
sw = True
Workbooks(ExtractFileName(.FoundFiles(i))).Close
Else
Workbooks(ExtractFileName(.FoundFiles(i))).Close
End If
Next i
If sw = False Then
MsgBox "No se encontró el texto especificado"
Else
If MsgBox("El criterio de busqueda " & TxtoBscar & _
" se encuentra en " & pos & " archivos." &
VNEWLINE & _
"¿Desea abrir estos archivos?",
vbInformation + vbYesNo, "Faturación") = vbYes Then
i = 0
While Len(VectorArchivos(i)) > 0
Workbooks.Open (VectorArchivos(i))
i = i + 1
Wend
End If
End If
Else
MsgBox "No se encontró ningún archivo."
End If
End With
Salir:
Exit Sub
Err:
MsgBox "Error: " & Err.Description, vbCritical + vbOKOnly, "Buscar"
Resume Salir
End Sub