Condividi:        

Macro che colletta dei file in varie cartelle

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Macro che colletta dei file in varie cartelle

Postdi tav » 23/04/18 21:06

Ciao a tutti

io ho dei file excel in varie cartelle con percorsi diversi. Tutti i file si chiamano nello stesso modo cioè SIM e la data del giorno in corso ( esempio SIM 23-04-18).

questi file devono essere collettati in un unico file che deve essere salvato in una nuova cartella e salvato semplicemente con il nome SIM.

ogni file deve essere copiato fino a che non trova la riga bianca, quando la trova deve iniziare a copiare dalla riga A6 del file successivo.

allego due dei file come esempio
https://we.tl/qlqRc9Twl3
tav
Utente Junior
 
Post: 46
Iscritto il: 08/04/18 20:57

Sponsor
 

Re: Macro che colletta dei file in varie cartelle

Postdi Anthony47 » 24/04/18 01:04

Beh, non puoi sempre passarci le specifiche funzionali e aspettare il risultato...

Allora diciamo che il tuo primo problema e' raccogliere l'elenco dei file da processare.
Per questo potresti usare la Function RecurDir creata per altro utente qui: http://pop.pc-facile.com/forum/viewtopi ... 62#p632405

Richiamerai questa RecurDir con lo stesso metodo descritto al link suddetto:
Codice: Seleziona tutto
Dim FArr() As String
ReDim FArr(1 To 1)
allpics = Array("xlsx")    '<<< Altri formati?       'Adattato al tuo caso
StrDir=" C:\PERCORSO\Documents"         '<<< Il Percorso iniziale
Call RecurDir(StrDir, allpics, FArr)

In questo modo avrai nella matrice Farr un elenco di file xlsx presenti nella directory StrDir e tutte le sue subdirectory.

In un ciclo successivo potrai scansionare il contenuto di Farr e determinare se il nome file comincia con "SIM ".
Anzi, pensandoci puoi mettere questo controllo direttamente nel codice della RecurDir in questo modo:
Codice: Seleziona tutto
ccAll = ccAll + 1
    mysplit = Split(" " & myItm, ".", , vbTextCompare)
    If Not IsError(Application.Match(mysplit(UBound(mysplit)), myExt, 0)) Then
        If InStr(1, mysplit(UBound(mysplit)), "SIM ", vbTextCompare) > 0 Then       '++++
            myind = UBound(cStore)
            ReDim Preserve cStore(1 To myind + 1)
            cStore(myind) = myItm
        End If                                                                      '++++
    End If
Mahh:
Rispetto al codice originale e' stato aggiunto il blocco If /End If marcato ++++

In questo modo avrai nella matrice Farr direttamente il nome dei file presenti nel filesystem a partire dal percorso che hai indicato e che si chiamino SIM *.xlsx

Ora sei pronto per aprire uno dopo l'altro i vari file, selezioni il foglio che serve, copi l'area che serve e la incolli nel file che stai creando nella posizione giusta.

Prova... e se ti areni fai sapere dove sei arrivato e su quale argomento hai invece frenato.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19465
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Macro che colletta dei file in varie cartelle

Postdi tav » 24/04/18 13:30

Ciao Anthony,

ho provato a mettere a posto la macro, ma quando la lancio il sistema si "impalla".continua a caricare fino a quando excel non si blocca



Codice: Seleziona tutto
Dim myFso As Object, ccAll As Long
Function RecurDir(ByVal ccDir As String, myExt As Variant, ByRef cStore As Variant) As String
Dim myItm
'
If myFso Is Nothing Then Set myFso = CreateObject("Scripting.FileSystemObject")
If myFso Is Nothing Then Beep
DoEvents
On Error GoTo Mahh
For Each myItm In myFso.GetFolder(ccDir).Files
ccAll = ccAll + 1
    mysplit = Split(" " & myItm, ".", , vbTextCompare)
    If Not IsError(Application.Match(mysplit(UBound(mysplit)), myExt, 0)) Then
        If InStr(1, mysplit(UBound(mysplit)), "SIM & "" & Format(now,dd-mm-yyyy)", vbTextCompare) > 0 Then       '++++
            myind = UBound(cStore)
            ReDim Preserve cStore(1 To myind + 1)
            cStore(myind) = myItm
        End If                                                                      '++++
    End If
Mahh:
Resume Bohh
Bohh:
Next myItm
For Each myItm In myFso.GetFolder(ccDir).SubFolders
    Call RecurDir(myItm, myExt, cStore)
Next myItm
End Function

Sub Pulsante1_Click()
Dim FArr() As String
ReDim FArr(1 To 1)
allpics = Array("xlsm")    '<<< Altri formati?       '***
StrDir = " \\193.43.114.144\shares\Divisione Buitoni\Supply Chain\Demand&Supply Planning\Business Position & Supply Issues Monitor BUITONI\SUPPLY ISSUES MONITOR\prova Andrea\storico ambi SIM"       '<<< Il Percorso iniziale
Call RecurDir(StrDir, allpics, FArr)
End Sub
tav
Utente Junior
 
Post: 46
Iscritto il: 08/04/18 20:57

Re: Macro che colletta dei file in varie cartelle

Postdi Anthony47 » 25/04/18 20:01

io ho dei file excel in varie cartelle con percorsi diversi
Quella macro parte dalla directory che gli dici e cerca in tutte le directory sottostanti; quindi quanto tempo richiedera' non lo so, dipende da quanto e' largo e lungo il filesystem sottostante.
Se invece tu sapessi gia' in quale directory cercare le cose sarebbero piu' semplici...
Avatar utente
Anthony47
Moderatore
 
Post: 19465
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Macro che colletta dei file in varie cartelle

Postdi tav » 25/04/18 20:51

Deve cercare in quel percorso e le cartelle sono 5 dentro le quali c sono vari file Excel e deve prendere solo quello con il nome sim più la data del giorno odierno
tav
Utente Junior
 
Post: 46
Iscritto il: 08/04/18 20:57

Re: Macro che colletta dei file in varie cartelle

Postdi Anthony47 » 26/04/18 14:00

Se la ricerca e' da fare in poche posizioni note allora diventa molto piu' semplice.
Ad esempio puoi memorizzare in una matrice i l'elenco dei file che rispettano il filtro con questa function:
Codice: Seleziona tutto
Function MonoDirXlsm(ByVal ccDir As String, myFilt As String, ByRef cStore As Variant) As Long
Dim myInd, myF As String
'
If Right(ccDir, 1) <> Application.PathSeparator Then ccDir = ccDir & Application.PathSeparator
myF = Dir(ccDir & myFilt)
Do While myF <> ""
Debug.Print myF
    myInd = UBound(cStore)
    ReDim Preserve cStore(1 To myInd + 1)
    cStore(myInd) = ccDir & myF
    DoEvents
    myF = Dir
Loop
MonoDirXlsm = UBound(cStore) - 1
End Function

Poi devi richiamarla con qualcosa tipo
Codice: Seleziona tutto
Sub Pulsante1_Click()
Dim FArr() As String, StrDir As String, Filtr As String
Dim NumF As Long
'
ReDim FArr(1 To 1)
Filtr = "SIM*.xlsm"                        '<<< Il "filtro"
StrDir = "C:\IlPercorso1"                   '<<< Il Percorso iniziale1
NumF = MonoDirXlsm(StrDir, Filtr, FArr)
StrDir = "C:\IlPercorso2"                   '<<< Il Percorso iniziale2
NumF = MonoDirXlsm(StrDir, Filtr, FArr)
StrDir = "C:\IlPercorso3"                   '<<< Il Percorso iniziale3
NumF = MonoDirXlsm(StrDir, Filtr, FArr)
'Ripetere per gli altri percorsi
'
'Qui il codice per processare i file individuati
'
End Sub

In questo modo ti troverai nella variabile NumF il numero di file individuati e in Farr il percorso + nome dei file file da processare.
Poi processerai i file con un ciclo del tipo
Codice: Seleziona tutto
For I=1 to NumF
    mioFile=FArr(i)
    '
    'le istruzioni per processare il singolo nome file
    'le istruzioni per processare il singolo nome file
    '
Next I

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19465
Iscritto il: 21/03/06 16:03
Località: Ivrea


Torna a Applicazioni Office Windows


Topic correlati a "Macro che colletta dei file in varie cartelle":


Chi c’è in linea

Visitano il forum: Nessuno e 10 ospiti