Newsgroup: it.comp.appl.access
Titolo: Ricerca dati all' interno di files *.xls

Ho un archivio storico di files *.xls (circa 200 ) posto all' interno di una 
directory e vorrei trovare dei dati (articoli) all' interno di questi files 
e importarli in una tabella di access.
Ho creato una maschera di ricerca (Storico_articoli) senza origine dati 
composta da:
- una sottomaschera (foglio dati) avente come origine dati una tabella 
(Storico_articoli).
- una casella combinata (CasellaCombinata62)dove vado ad inserire il [patch] 
dell' archivio.
- una casella di testo (CasellaCombinata64) dove inserire la stringa 
(articolo) da ricercare.
- un pulsante (Comando70) che mi avvia la ricerca e al quale č associato il 
seguente codice:
Option Compare Database
Option Explicit
Private Sub Comando70_Click()
    Dim xl As Excel.Application
    Dim e As Integer
    Dim Articolo As String
    Dim percorso As String
    Dim hsearch As Long
    Dim findinfo As WIN32_FIND_DATA
    Dim buffer As Variant
    Dim retval As Long
    Dim success As Long
    Dim rs As Recordset
    Dim c As Range
    Dim p As Range
    Dim firstAddress As String
    If Me!CasellaCombinata62 <> "" And Me!CasellaCombinata64 <> "" Then 
' Verifica che il patch e la stringa di ricerca siano presenti
        Set rs = CurrentDb.OpenRecordset("Storico_articoli")       ' Crea il 
recordset dove inserire gli eventuali articoli trovati
        percorso = Me!CasellaCombinata62 & "\*.xls"       ' Stringa di 
ricerca da passare FindFirstFile e FindNextFile
        Articolo = Me!CasellaCombinata64           ' articolo da ricercare
        hsearch = FindFirstFile(percorso, findinfo)          ' Cerca il 
primo file *.xls all' interno del patch
        Do       ' Ciclo per la ricerca di tutti gli *.xls all' interno del 
patch
            buffer = Left(findinfo.cFileName, InStr(findinfo.cFileName, 
vbNullChar) - 1)       ' Nome del file trovato
            Set xl = CreateObject("Excel.Application")
            xl.Workbooks.Open (Me!CasellaCombinata62 & "\" & buffer)
            For e = 1 To xl.Sheets.Count       ' Ciclo per il numero di 
fogli presenti all' interno del file trovato
                With xl.Sheets(e).Range("A1:A500")
                    Set p = .Find("RIEPILOGO")    ' Cerca all' interno del 
foglio la parola "RIEPILOGO" che mi indica la riga dove 
' interrompere la ricerca dell' articolo
                    If Not p Is Nothing Then
                        With xl.Sheets(e).Range(Cells(1, 1), Cells(p.Row, 
1))      ' Stabilisce il Range dove cercare
                            Set c = .Find(Articolo)          ' Cerca l' 
articolo
                            If Not c Is Nothing Then          ' Se non trova 
l' articolo passa ad un altro foglio
                                firstAddress = c.Address        ' Punto di 
partenza della ricerca
                                Do       ' Ciclo per la presenza di piů 
artcoli nello stesso foglio
                                        Set c = .FindNext(c)
                                        If Not c Is Nothing Then     ' 
Scrive nel recordset i dati trovati
                                            rs.AddNew
                                            rs!Articolo = 
xl.Sheets(e).Cells(c.Row, 1)
                                            rs!UdM = 
xl.Sheets(e).Cells(c.Row, 6)
                                            rs!Fornitura = 
xl.Sheets(e).Cells(c.Row, 8)
                                            rs!Trasporto = 
xl.Sheets(e).Cells(c.Row, 10)
                                            rs!Posa = 
xl.Sheets(e).Cells(c.Row, 12)
                                            rs!Patch = Me!CasellaCombinata62 
& "\" & buffer
                                            rs.Update
                                        End If
                                Loop While Not c Is Nothing And c.Address <> 
firstAddress
                            End If
                        End With
                    End If
                End With
            Next e
            xl.Quit
            success = FindNextFile(hsearch, findinfo)
        Loop Until success = 0
        retval = FindClose(hsearch)
        rs.Close
        Storico_articoli.Form.Requery
        MsgBox "Ricerca terminata.", vbInformation, "Ricerca terminata"
    Else
        MsgBox "Inserire patch archivio e stringa da cercare !", 
vbExclamation, "Impossibile avviare ricerca"
        Exit Sub
    End If
End Sub
- Un modulo a parte (Operazioni_files) con il seguente codice:
Option Compare Database
Option Explicit
Declare Function FindFirstFile Lib "kernel32.dll" Alias "FindFirstFileA" 
(ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindNextFile Lib "kernel32.dll" Alias "FindNextFileA" 
(ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindClose Lib "kernel32.dll" (ByVal hFindFile As Long) As 
Long
Declare Function CreateDirectory Lib "kernel32.dll" Alias "CreateDirectoryA" 
(ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As 
Long
Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type
Type WIN32_FIND_DATA
  dwFileAttributes As Long
  ftCreationTime As FILETIME
  ftLastAccessTime As FILETIME
  ftLastWriteTime As FILETIME
  nFileSizeHigh As Long
  nFileSizeLow As Long
  dwReserved0 As Long
  dwReserved1 As Long
  cFileName As String * 260
  cAlternate As String * 14
End Type
Type SECURITY_ATTRIBUTES
  nLength As Long
  lpSecurityDescriptor As Long
  bInheritHandle As Boolean
End Type
La ricerca funziona per un foglio ma al ciclo "for" sucessivo mi da un 
errore di Run Time legato alla riga "With xl.Sheets(e).Range(Cells(1, 1), 
Cells(p.Row, 1))".
Ho notato che nel task manager rimane un processo EXCEL.EXE attivo 
(probabilmente legato al foglio di lavoro) e credo che il problema sia 
questo.
Grazie 1.000.000 a chi puň aiutarmi a risolvere il problema (anche cambiando 
tipo di soluzione adottata).
PS: Qualcuno ha un idea da suggerirmi per fare in modo che nella ricerca 
file sopra descritta vengano incluse anche le sottodirectory ?

 file sopra descritta vengano incluse anche le sottodirectory ?
fatti un giro su 
www.sistocomune.com
 e 
www.donkarl.com/it
 e magari fai 
uan ricerca sui messaggi vecchi del NG con parola chiave "sottodirectory"
Consiglio: evita di copiaincollare vagonate di codice. Rischi che non lo 
legga nessuno.In questo caso visto che hai usato le API puo' darsi che 
A. Baraldi lo legga, ma dubito. Esponi il problema in forma semplice e 
soprattutto apri un 3D per ogni quesito, in questo modo aumentano le 
probabilita' che tu ne possa venire a capo in modo veloce.
A conferma di quanto dico. Il tuo post lo ho aperto e richiuso. Visto 
poi che oggi gli stakanovisti del NG non ci sono ho cercato di darti una 
prima indicazione.
--
a.cara

 file sopra descritta vengano incluse anche le sottodirectory ?
Prima di tutto relativamente al codice che hai esposto direi che
chi ha il coraggio di leggerlo è un Santo.
In ogni caso non ha problemi da quanto mi pare, solo che
la tecnica per includere le SubDir(che sono delle DIR) è la
ricorsione, e quello che hai scritto non è ricorsivo.
Scrivere funzioni ricorsive è leggermente più complesso, ma in questo
caso è l'unico modo.
Ti posto una funzione Ricorsiva che scandisce DIR e SUBDIR a tutti
i livelli.
Povala:
Esempio metti una LISTBOX(Elenco Valori) in una Form e su Load 
scrivi:
Me!NomeListBox.RowSource=RetCataloghi("C:\Programmi\")
e vedi che succede....!
'------------------------ MODULO --------------------------
Option Compare Database
Option Explicit
Dim strFileCatalogo As String
Public Function RetCataloghi(strPath As String) As String
    strFileCatalogo = vbNullString
    Call ScansioneCartelle(strPath)
    RetCataloghi = strFileCatalogo
End Function
Sub ScansioneCartelle(ByVal ActPath$)
    Dim AttributiFile  As Integer
    Dim ElencoCartelle$
    Dim File$
    Dim ElaboraFile As String
    ElencoCartelle$ = ""
    If Right$(ActPath$, 1) <> "\" Then ActPath$ = ActPath$ & "\"
    On Error Resume Next
    File$ = Dir$(ActPath$ & "*.*", vbDirectory + vbNormal)
    Do While Len(File$)
        If File$ <> "." And File$ <> ".." Then
            Err = 0
            ' Ricavo gli attributi del file per vedere se è una cartella
e se il file è valido ed accessibile
            ' inoltre se vi serve conoscere gli attributi, sono in
AttributiFile
            AttributiFile = GetAttr(ActPath$ & File$)
            If Err = 0 Then
                If (AttributiFile And vbDirectory) Then
                    ' File$ è una cartella
                    ' Mi ricordo che questa cartella la dovro' scandire
                    ElencoCartelle$ = ElencoCartelle$ & File$ & vbCrLf
                Else
                    ' File$ è un file
                    ' LO analizzo
                    If Right$(File$, 3) = "mdb" Then _
                        strFileCatalogo = strFileCatalogo & Mid$(File$,
1, InStr(File$, ".") - 1) & ";"
                    'CreaFile file$
                End If
            End If
        End If
        File$ = Dir$
    Loop
    On Error GoTo 0
 
    ' Tutte le sottocartelle in modo ricorsivo
    Dim pos%
    Do While Len(ElencoCartelle$)
 
        pos% = InStr(ElencoCartelle$, vbCrLf)
        If pos% Then
            File$ = ActPath$ & Left$(ElencoCartelle$, pos% - 1)
            ElencoCartelle$ = Mid$(ElencoCartelle$, pos% + Len(vbCrLf))
        Else
            File$ = ActPath$ & ElencoCartelle$
            ElencoCartelle$ = ""
        End If
 
        Call ScansioneCartelle(File$)
    Loop
    ElencoCartelle$ = ElaboraFile
End Sub
Ciao
@Alex
-- 
Posted via Mailgate.ORG Server - 
http://www.Mailgate.ORG

 file sopra descritta vengano incluse anche le sottodirectory ?
qui ho visto che ti hanno già dato alcuni spunti.
Ciao
-- 
Giorgio Rancati
[Office Access MVP]

 ----
ops.
----
With xl.Sheets(e).Range(xl.Sheets(e).Cells(1, 1), xl.Sheets(e).Cells(p.Row,
1))".
----


 sottodirectory ?
Aggiungo alcune cose ai suggerimenti già inviati:
- dopo il ciclo For tu chiudi l'oggetto application (xl.Quit) ma immediatamente dopo lo ricrei (CreateObject) senza averlo distrutto 
(Set xl = nothing) e questo potrebbe generare "comportamenti strani".
Ti consiglio di:
- o creare l'oggetto prima di entrare del ciclo Do, e dopo il Loo Until chiudere/distruggere l'oggetto;
- o di distruggere l'oggetto dopo il xl.Quit;
- di non chiudere l'oggetto application se hai altri file da leggere, chiudi solo il documento attivo (xl.ActiveWorkBook.Close), 
risparmi risorse ed è più veloce l'esecuzione della routine;
- di inserire nella routine una gestione degli errori che distrugge tutti gli oggetti creati.
Ciao.
-- 
Sergio MAZZA