macro serch

Salve a tutti,
spulciando nella varie macro che ho nel computer ho trovato questa che non gira più.
Non ricordo dove l'ho trovata.
Quando la usavo mi ricercava determinati valori che scrivevo nell'imptbox che si vusualizza.
Ora dà errore 445 azione non valida per l'oggetto.
Allego l'esempio.
patrik

Probabilmente hai avuto modo di utilizzare quella macro con una versione di Excel ante 2K7. Da Excel 2K7 e successive la funzione non esiste più e devi trovare una funzione sostitutiva. In rete c'è parecchio materiale dato che il problema l'hanno avuto in molti.

La parte che non va è questa un aiuto?

Sub apri_e_verifica()
Dim obiettivo
Dim A As Range
Dim trova As FileSearch
Dim cartella As Integer
Dim x As Long
Dim cl As Range
Dim nome_file As String
Dim vuoto As Boolean

'Set trova = Application.FileSearch

vuoto = False

'IMPOSTO LA VARIABILE "x" COME INDICE DI RICERCA DELL'ULTIMA RIGA
'OCCUPATA DELLA COLONNA A DEL FILE "provaigor"
x = Workbooks("search_file.xls").Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1

'CANCELLO IL RANGE DOVE VERRANNO INSERITI I DATI
Workbooks("search_file.xls").Sheets(1).Range("A2:C" & x).ClearContents

obiettivo = InputBox("Inserisci il codice da cercare", "Ricerca codice")
Application.ScreenUpdating = False

'SE L'INPUTBOX è VUOTA, AVVISA ED ESCE DALLA ROUTINE
If obiettivo = "" Then
vuoto = True
MsgBox "devi inserire un codice", vbExclamation, "ATTENZIONE"
End If
If Not vuoto Then

With trova

'INDICO IL PERCORSO DELLA CARTELLA DOVE SONO I FILE DA APRIRE
.LookIn = "C:\Users\massimo\Desktop\moduli_salvati\BARILLA-101\VITERIE"

'INDICO IL TIPO DI FILE DA APRIRE
.Filename = "*.xls"

'METODO EXECUTE RESTITUISCE IL NUMERO DEI FILES DELLA
'DIRECTORY SPECIFICATA; SE è = 0 AVVISA ED ESCE DALLA ROUTINE
If .Execute() > 0 Then

'CICLO FOR CHE APRE TUTTI I FILE CONTENUTI NELLA CARTELLA "igor"
'CON LA PROPRIETà "FoundFiles"
'DALL'HELP ON LINE :
'Restituisce un oggetto FoundFiles contenente i nomi di tutti i
'file trovati durante la ricerca. Di sola lettura.
' E CON LA PROPRIETà "Count" CHE RESTITUISCE IL NUMERO
'DELL'ULTIMO FILE

For cartella = 1 To .FoundFiles.Count
Workbooks.Open .FoundFiles(cartella)
nome_file = ActiveWorkbook.Name
Set A = Workbooks(nome_file).Sheets(1).Range("A3:A41")

'CICLO PER VERIFICARE L'ESISTENZA DEL CODICE NEI FILES; SE LO TROVA,
'INSERISCE IL CODICE, IL NOME DEL FILE E L'INDIRIZZO DELLA CELLA
'NEL FILE "provaigor", ED ESSENDO UN CODICE UNIVOCO, ESCE DAL CICLO E
'PASSA AL FILE SUCCESSIVO
For Each cl In A
If cl = obiettivo Then
With Workbooks("search_file.xls").Sheets(1)

'RE-IMPOSTO LA VARIABILE "x" COME INDICE DI RICERCA DELL'ULTIMA RIGA
'OCCUPATA DELLA COLONNA A DEL FILE "provaigor"
x = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Range("A" & x) = cl
.Range("B" & x) = Workbooks(nome_file).Name
.Range("C" & x) = cl.Address(False, False)
End With
Exit For
End If
Next cl

'CHIUDO LA CARTELLA ATTIVA
Workbooks(nome_file).Close

'PROSSIMO FILE DA APRIRE
Next cartella

Else
MsgBox "Nella directory scelta non ci sono Files"
End If
End With

If Workbooks("provaigor_2.xls").Sheets(1).Range("A2") = "" Then
MsgBox "Non è stato trovato nessun codice " & obiettivo, vbExclamation, _
"VERIFICA CONCLUSA"
Else
MsgBox "Il codice " & obiettivo & " è stato trovato in " & x - 1 & " file/s", _
vbInformation, "VERIFICA CONCLUSA"
End If
End If
Application.ScreenUpdating = True
Set A = Nothing
Set trova = Nothing
End Sub

patrik

Qui c'è una soluzione interessante se per te l'inglese non è un problema: https://answers.microsoft.com/en-us/msoffice/forum/msoffice_excel-msoffice_custom/i-have-a-spreadsheet-which-uses/669118de-e3a5-4815-bb95-0a83eb6bf984

Ciao rollis,
da quello che ho capito bisogna scaricare un file con estensione cls e installarlo in excel, sarebbe un'aggiunta (add-on).
Non so se poi funzioni in altri computer.
Una modifica alla prima macro non è possiile?
patrik

Ciao
da quel che ho capito tu devi cercare in tutti i file di una determinata cartella un certo valore impostato da InputBox.

Quel che non mi è chiaro è se tale valore va ricercato in uno specifico foglio contenuto nei files o in tutti i fogli di ciascun file. Inoltre il valore cercato può essere presente in più celle?

Ciò premesso basterebbe ciclare la directory interessata con Dir, aprire ciascun file, effettuare la ricerca sul determinato foglio (o su tutti i fogli con apposito loop) con la funzione Find, e riportare i valori voluti nel foglio originale.

saluti

Ciao dodo47.
La macro ricerca nella cartalla indicata tutti i valori indicati nell'imputbox. I fogli devono essere tutti uguali perchè i valori devono essere nelle stesse colonne.
patrik

Ciao rollis,
Ho scaricato il modulo di classe come indicato nel link da te segnalato.
Si è installato, ho cambiato:
da Set trova = Application.FileSearch
a Set trova = ApplicationFileSearch
ma non gira dove sbaglio?
Allego il file modificato.
patrik

Mancava in testa al modulo:

Public ApplicationFileSearch As New FileSearch

ora gira.
patrik

Ora il file search_file.xls funziona con la dritta di rollis.
Per funzionare bisogna indicare la cartella della ricerca, se dentro ci sono altre cartella la macro non trova i file.
E' possibile che la macro ricerchi i file anche nelle sotto-cartelle?.
Un grazie a tutti (1° rollis).
patrik

Ho fatto una modifica per la ricerca "manualmente" nelle sottocartelle ma non mi funziona il riferimento dal VBA alle celle del foglio:


==================================================================================================

Public ApplicationFileSearch As New FileSearch

Sub apri_e_verifica()
Dim obiettivo
Dim A As Range
Dim trova As FileSearch
Dim cartella As Integer
Dim x As Long
Dim cl As Range
Dim nome_file As String

Dim Comm1, Comm2, Comm3 As String

Dim vuoto As Boolean
Set trova = ApplicationFileSearch
vuoto = False


'IMPOSTO LA VARIABILE "x" COME INDICE DI RICERCA DELL'ULTIMA RIGA
'OCCUPATA DELLA COLONNA A DEL FILE "search_file"

x = Workbooks("search_file.xls").Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1

'CANCELLO IL RANGE DOVE VERRANNO INSERITI I DATI

Workbooks("search_file.xls").Sheets(1).Range("A2:C" & x).ClearContents

obiettivo = InputBox("Inserisci il codice da cercare", "Ricerca codice")
Application.ScreenUpdating = False

'SE L'INPUTBOX è VUOTA, AVVISA ED ESCE DALLA ROUTINE

If obiettivo = "" Then
vuoto = True
MsgBox "devi inserire un codice", vbExclamation, "ATTENZIONE"
End If
If Not vuoto Then

With trova

'INDICO IL PERCORSO DELLA CARTELLA DOVE SONO I FILE DA APRIRE


'Comm1 = Foglio1.Range("E1").Value
'Comm2 = Foglio1.Range("G1").Value

Comm1 = ActiveSheet.Range("E1").Value '<<< nome cella 1
Comm2 = ActiveSheet.Range("G1").Value '<<< nome cella 2
Comm3 = Comm1 & "-" & Comm2 '<<< unite


.LookIn = "C:\Users\massimo\Desktop\MAX\moduli_salvati\" & Comm3 'new
'.LookIn = "C:\Users\massimo\Desktop\MAX\moduli_salvati\"

'INDICO IL TIPO DI FILE DA APRIRE

.FileName = "*.xls"

'METODO EXECUTE RESTITUISCE IL NUMERO DEI FILES DELLA
'DIRECTORY SPECIFICATA; SE è = 0 AVVISA ED ESCE DALLA ROUTINE

If .Execute() > 0 Then

'CICLO FOR CHE APRE TUTTI I FILE CONTENUTI NELLA CARTELLA "moduli_salvati"
'CON LA PROPRIETà "FoundFiles"
'DALL'HELP ON LINE :
'Restituisce un oggetto FoundFiles contenente i nomi di tutti i
'file trovati durante la ricerca. Di sola lettura.
' E CON LA PROPRIETà "Count" CHE RESTITUISCE IL NUMERO
'DELL'ULTIMO FILE

For cartella = 1 To .FoundFiles.Count
Workbooks.Open .FoundFiles(cartella)
nome_file = ActiveWorkbook.Name
Set A = Workbooks(nome_file).Sheets(1).Range("L7:L31")

'CICLO PER VERIFICARE L'ESISTENZA DEL CODICE NEI FILES; SE LO TROVA,
'INSERISCE IL CODICE, IL NOME DEL FILE E L'INDIRIZZO DELLA CELLA
'NEL FILE "search_file", ED ESSENDO UN CODICE UNIVOCO, ESCE DAL CICLO E
'PASSA AL FILE SUCCESSIVO

For Each cl In A
If cl = obiettivo Then
With Workbooks("search_file.xls").Sheets(1)

'RE-IMPOSTO LA VARIABILE "x" COME INDICE DI RICERCA DELL'ULTIMA RIGA
'OCCUPATA DELLA COLONNA A DEL FILE "search_file"

x = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Range("A" & x) = cl
.Range("B" & x) = Workbooks(nome_file).Name
.Range("C" & x) = cl.Address(False, False)
End With
Exit For
End If
Next cl

'CHIUDO LA CARTELLA ATTIVA

Workbooks(nome_file).Close

'PROSSIMO FILE DA APRIRE

Next cartella

Else
MsgBox "Nella directory scelta non ci sono Files"
End If
End With

If Workbooks("search_file.xls").Sheets(1).Range("A2") = "" Then
MsgBox "Non è stato trovato nessun codice " & obiettivo, vbExclamation, _
"VERIFICA CONCLUSA"
Else
MsgBox "Il codice " & obiettivo & " è stato trovato in " & x - 1 & " file/s", _
vbInformation, "VERIFICA CONCLUSA"
End If
End If
Application.ScreenUpdating = True
Set A = Nothing
Set trova = Nothing
End Sub

==================================================================================================

un aiuto?
patrik

Dato che molti riferimenti sono a file mancanti è difficile testare la tua macro.

Ad occhio: non è che nel percorso che ricavi con:
devi aggiungere il separatore finale, così:

Ciao rollis è sempre o.k. con te
La modifica per la ricerca anche nelle sotto cartelle non è possibile?
Ho ricercato in rete ma non so come modificare la macro.
patrik

Postato in altro forum:
http://archi.forumup.it/viewtopic.php?p=86299&mforum=archi#86299
patrik

Allego 2 file:
search_file
PROVA1.xls


Perchè tutto funzioni bisogna creare nel desktop una cartella nominata MAX
dentro a questa un'altra cartella nominata PROVA-123.
Dentro alla cartella PROVA-123 inserire PROVA1.xls
Nel file search_file
in B1 scivere il nome: PROVA
in B1 scivere il nome: 123
e il search_file trova quello che è inserito nelle celle L7:L31
se tutti i file sono dentro alla cartella PROVA-123 vengono trovati da search_file
se sono dentro ad qualche sottocartella non voengono trovati.
Spero ora con gli esempi di essermi spiegato.
patrik