Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Visual Basic » Buscar en excel de carpetas y subcarpetas

Visual Basic - Buscar en excel de carpetas y subcarpetas

Life is soft - evento anual de software empresarial
Volver
Nuevo Tema
<<>>
 
Vista:

Buscar en excel de carpetas y subcarpetas

Publicado por Alvaro (19 intervenciones) el 03/06/2015 09:11:04
Muy buenas!
Estoy haciendo un programa que busca un termino dentro de todos los Excel de una carpeta. El código de esto ya lo tengo, el problema es que ahora tengo que llevarlo mas adelante y hacer que busque en los Excels de carpetas y subcarpetas ¿como hago para que realice esta tarea?

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
Dim posicion As Integer = InStr(foundFile, ".")
                If posicion = 0 Then
                    posicion = 1
                End If
                Dim extension As String = Mid(foundFile, posicion)
                If extension = ".xls" Or extension = ".xlsm" Or extension = ".xlt" Or extension = ".xlsx" Then
                    Try
                        Dim oExcel As Excel.Application
                        oExcel = New Excel.Application
 
                        oExcel.Workbooks.Open(foundFile, , False)
                        oExcel.Visible = False
                        Dim PosicionActual As Excel.Range = Nothing
                        Dim PrimeraPosicion As Excel.Range = Nothing
 
                        Dim Rango As Excel.Range = oExcel.Range("A1", "Z200")
 
                        Dim busqueda As String = txtBusqueda.Text
                        PosicionActual = Rango.Find(busqueda, , _
                            Excel.XlFindLookIn.xlValues, Excel.XlLookAt.xlPart, _
                            Excel.XlSearchOrder.xlByRows, Excel.XlSearchDirection.xlNext, False)
 
                        While Not PosicionActual Is Nothing
 
 
                            If PrimeraPosicion Is Nothing Then
                                PrimeraPosicion = PosicionActual
 
 
                            ElseIf PosicionActual.Address = PrimeraPosicion.Address Then
 
                            End If
 
                            With PosicionActual.Font
 
                                contador += 1
                                ListBox1.Items.Add(foundFile)
                                Exit While
 
                            End With
 
                            PosicionActual = Rango.FindNext(PosicionActual)
                        End While
                    Catch ex As Exception
                    End Try
                End If
 
            Next
            MsgBox(contador.ToString & " referencia encontrada!", MsgBoxStyle.Information)
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

Buscar en excel de carpetas y subcarpetas

Publicado por Alvaro (19 intervenciones) el 03/06/2015 09:55:21
Actualización.

He conseguido que lo haga, pero me sale Error numero 13 en el tiempo de ejecución y el msgbox de el final por cada vez que cambia de carpeta.
¿Alguna sugerencia?

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
Sub GetAllFiles(strPath As String)
        Dim objRoot As New DirectoryInfo(strPath)
 
 
        If objRoot.Exists Then
            'if you don't want this to be recursive, remove this for loop

            For Each objSubDir As DirectoryInfo In objRoot.GetDirectories
                GetAllFiles(objSubDir.FullName)
            Next
 
            'keep this for loop

            Dim contador As Integer
 
            For Each objFile As FileInfo In objRoot.GetFiles
                '-------------------------------------------------------------------------------------------------------------------------------------------

 
 
 
 
 
                Dim posicion As Integer = InStr(strPath & "\" & objFile.Name, ".")
                If posicion = 0 Then
                    posicion = 1
                End If
                Dim extension As String = Mid(strPath & "\" & objFile.Name, posicion)
                If extension = ".xls" Or extension = ".xlsm" Or extension = ".xlt" Or extension = ".xlsx" Then
                    Try
                        Dim oExcel As Excel.Application
                        oExcel = New Excel.Application
 
                        oExcel.Workbooks.Open(strPath & "\" & objFile.Name, , False)
                        oExcel.Visible = False
                        Dim PosicionActual As Excel.Range = Nothing
                        Dim PrimeraPosicion As Excel.Range = Nothing
 
                        Dim Rango As Excel.Range = oExcel.Range("A1", "Z200")
 
                        Dim busqueda As String = txtBusqueda.Text
                        PosicionActual = Rango.Find(busqueda, , _
                            Excel.XlFindLookIn.xlValues, Excel.XlLookAt.xlPart, _
                            Excel.XlSearchOrder.xlByRows, Excel.XlSearchDirection.xlNext, False)
 
                        While Not PosicionActual Is Nothing
 
 
                            If PrimeraPosicion Is Nothing Then
                                PrimeraPosicion = PosicionActual
 
 
                            ElseIf PosicionActual.Address = PrimeraPosicion.Address Then
 
                            End If
 
                            With PosicionActual.Font
 
                                contador += 1
                                ListBox1.Items.Add(strPath & "\" & objFile.Name)
                                Exit While
 
                            End With
 
                            PosicionActual = Rango.FindNext(PosicionActual)
                        End While
                        oExcel = Nothing
                    Catch ex As Exception
                    End Try
 
                End If
 
                Call eliminar() 'Esto elimina los procesos EXCEL.EXE por si acaso

            Next
            MsgBox(contador.ToString & " referencia encontrada!", MsgBoxStyle.Information)
            '-------------------------------------------------------------------------------------------------------------------------------------------

 
        End If
    End Sub
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar