Sviluppare funzionalita su Microsoft Office con VBA Estrazione celle da piu file nella stessa cartella

Login Registrati
Stai vedendo 25 articoli - dal 1 a 25 (di 50 totali)
  • Autore
    Articoli
  • #36533 Score: 0 | Risposta

    FROST220684
    Partecipante

      Buongiorno a tutti e grazie in anticipo a chiunque mi darà una mano.

      espongo il problema:

      1. ho 2 file nella stessa cartella identici

      2. da questi 2 file devo prelevare alcuni dati presenti in alcune celle per generare un database

      3. ho creato un file nuovo che ho messo nella stessa cartella dei file in questione ed attraverso una macro prelevo tutti i dati a me necessari (funziona egregiamente)

      4. l'unico problema è che in fase di prelevamento mi esce sempre una sorta di errore che mi chiede di aggiornare i dati e devo cliccare sempre su non aggiornare per andare avanti ed arrivare alla conclusione della macro.

      5. allego il file creato per il database e 2 file esempio in modo da farvi capire ed avrei necessità di eliminare questo errore di cui allego immagine

       

      grazie mille a tutti

      Allegati:
      You must be logged in to view attached files.
      #36537 Score: 0 | Risposta

      FROST220684
      Partecipante

        allego immagine errore in quanto mi faceva caricare solo 3 file.

        altra necessità se possibile:

        1. ora sono 2 file. se in un futuro aggiungessi altri file dello stesso tipo. potrei far scartare alla macro i file gia prelevati? come una sorta di database in continuo aggiornamento

        Allegati:
        You must be logged in to view attached files.
        #36539 Score: 0 | Risposta

        patel
        Moderatore
          51 pts

          Prova a inserire all'inizio

          Application.DisplayAlerts = False

          ed alla fine

          Application.DisplayAlerts = True
          #36540 Score: 0 | Risposta

          FROST220684
          Partecipante
            `Sub file_riassuntivo()
                Application.DisplayAlerts = False
                Application.ScreenUpdating = False
                Dim percorso As String
                Dim nomeFile As String
                Dim WB As Workbook
                Dim sh As Worksheet
                percorso = ThisWorkbook.Path & "\"
                nomeFile = Dir(percorso)
                Do While nomeFile <> ""
                    If nomeFile <> ThisWorkbook.Name Then
                        Set WB = Application.Workbooks.Open(percorso & nomeFile)
                        Set sh = WB.Worksheets(1)
                        sh.Range("B1:B11").Copy
                        ThisWorkbook.Sheets(1).Activate
                        uR = Cells(Rows.Count, 1).End(xlUp).Row + 1
                        If Cells(2, 1) = 1 Then
                            Cells(uR, 1) = Cells(uR - 1, 1) + 1
                        Else
                            Cells(2, 1) = 1
                        End If
                        Cells(uR, 2).PasteSpecial Paste:=xlValues, Transpose:=True
                        WB.Close False
                    End If
                    nomeFile = Dir
                Loop
                Application.ScreenUpdating = True
                Application.DisplayAlerts = True
                MsgBox "Dati Importati.", vbInformation, "OK"
            End Sub
            `

            ho provato ad inserirlo cosi ma da sempre errore. Non so se ho sbagliato qualcosa. sembra un errore di percorso infatti me lo chiede per ogni file che analizza e cliccando su non aggiornare va avanti fino alla fine. arrivati alla fine la macro ha fatto il suo lavoro quindi si tratterebbe solo di ignorare questo errore. 

            cosa successiva sarebbe quella di ignorare i file per cui sono gia stati prelevati dati altrimenti il file li aggiunge a prescindere

            #36545 Score: 0 | Risposta

            vecchio frac
            Senior Moderator
              272 pts

              Il problema dei collegamenti che devono essere aggiornati dipende sicuramente da qualche formula che fa riferimento a un file diverso (non ho capito bene in quale dei due file compare il messaggio, a me non appare quando apro i file allegati). Lo so perché ci ho sbattuto la testa per altri miei progetti prima di capirlo 🙂

              Per il resto del discorso... oggi ho il pomeriggio impegnato ma appena posso entrerò nel merito per dare qualche suggerimento 🙂

              #36546 Score: 0 | Risposta

              FROST220684
              Partecipante

                il messaggio compare nel file: File Database - e non appare quando apri il file ma quando avvii la macro

                gli altri 2 file sono quelli da cui questo file deve prendere i dati quindi non serve nemmeno aprirli. che sono poi i file preventivi che creava il file su cui abbiamo lavorato nella settimana scorsa. quindi in sommi capi io faccio preventivi con il file che abbiamo elaborato la scorsa settimana che mi salva una copia in xls in una cartella. mentre questo file database deve solo prelevare i dati dai file creati ed oltretutto premendo sempre su non aggiornare o aggiornare alla fine lo fa.

                tranquillo anzi grazie della pazienza a tutti

                #36561 Score: 0 | Risposta

                vecchio frac
                Senior Moderator
                  272 pts

                  Sto guardando il file "File Database.xlsm".
                  Per favore metti sempre in testa ai tuoi moduli la direttiva Option Explicit.
                  Può sembrare una seccatura ma ti assicuro che è un salvavita (per esempio, uR non è definito).

                  La richiesta di aggiornare i collegamenti avviene quando il codice apre il primo dei file preventivi che incontra. Aprendolo ("50600 - giada...xlsx") si scopre che ci sono dei collegamenti derivanti da formule presenti in un vecchio file di lavoro ("a schema preventivo VBA definitivo.xlsm") che dovrebbe trovarsi in "c:\users\anna\desktop\" (e che naturalmente il mio Excel non trova, sia perchè non ho un utente "anna" sia perchè non ho il file cui tenta di collegarsi).

                  Ti conviene aprirlo manualmente, interrompere i collegamenti e salvarlo. Se così non si risolve proveremo un altro modo. I collegamenti puoi vederli dalla tab Dati, poi clicca su Modifica collegamenti (sempre il file 50600 giada, intendo; ma anche il file 50700 sabrina ha lo stesso problema). Il punto è che questi file derivano da una copia del master: a far bene (o benissimo), bisognerebbe consolidare i valori nelle celle dopo aver fatto la copia del workbook originale. Se serve ne riparliamo.
                  Per il resto il codice funziona 🙂

                  Nota 1: ho visto il foglio modelli. Era proprio così che intendevo. Ottimo lavoro   
                  (joke mode on) Nota 2: quest'anno siamo in vacanza da voi?   (joke mode off)

                  #36562 Score: 0 | Risposta

                  albatros54
                  Moderatore
                    89 pts

                    vecchio frac ha scritto:

                    poi clicca su Modifica collegamenti

                    poi fai Clik sul pulsante "Prompt di avvio" è spunti "Non visualizzare l'avviso e non aggiornare automaticamente i collegamenti", salva il file. Alla prossima apertura non comparira il messaggio di che ti chie di aggiornare i collegamenti.

                     

                    Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
                    Sempre il mare, uomo libero, amerai!
                    ( Charles Baudelaire )
                    #36563 Score: 0 | Risposta

                    vecchio frac
                    Senior Moderator
                      272 pts

                      A dirla tutta stavo cercando queste benedette formule collegate ma non le trovo. Non riesco a capire cosa può essere. Però è  quasi certo che si tratta di collegamenti esterni.

                      #36564 Score: 0 | Risposta

                      vecchio frac
                      Senior Moderator
                        272 pts

                        Trovato! I nomi esterni sono nella definizione dei range denominati.
                        Quindi controlla in Formule --> Gestione nomi quali sono i riferimenti esterni ed eliminali 🙂

                        #36565 Score: 0 | Risposta

                        FROST220684
                        Partecipante

                          albatros54 ha scritto:

                          poi fai Clik sul pulsante "Prompt di avvio" è spunti "Non visualizzare l'avviso e non aggiornare automaticamente i collegamenti", salva il file. Alla prossima apertura non comparira il messaggio di che ti chie di aggiornare i collegamenti.

                          allora cosi si risolve il problema è che sono tantissimi voi ne vedete 2 ma sono migliaia e quindi è impossibile farlo uno ad uno. a questo punto il problema non è piu' sul file Database ma bensì sul file che genera i preventivi su cui abbiamo lavorato vecchio frac ed io perchè è come se il preventivo generato in xls rimanesse ancorato al file vergine

                          vecchio frac ha scritto:

                          ("a schema preventivo VBA definitivo.xlsm")

                          riuscite ad aiutarmi in questo? secondo me andrebbe modificato qualcosa nella creazione del file xls che generi un file non ancorato all'originale oppure che nel salvataggio del file faccia l'operazione di disancoraggio che suggeriva albatros54. questo mi aiuterebbe per tutti i file generati da oggi in avanti per i vecchi vedro come gestirli (anche se potrebbe essere utile una macro che effettua il disancoraggio di albatros54 in tutti i file della cartella). sto dando di matto   

                          ragazzi scusate mi sta andando in fumo il cervello. in sommi capi

                          1. il file "a schema preventivo VBA definitivo.xlsm" crea una copia in xlsx che deve essere non collegato al file originale

                          2. il file database in questo caso non darebbe problemi

                          allegati:

                          1. file originale gia compilato basta premere sul tasto salva excel e pdf avendo cura di modificare nel linguaggio la destinazione della cartella

                          2. file database

                           

                          Allegati:
                          You must be logged in to view attached files.
                          #36568 Score: 0 | Risposta

                          vecchio frac
                          Senior Moderator
                            272 pts

                            Se elimini i nomi definiti sul file "a Schema preventivo settimanale VBA per Fabio", questi non si propagano sui file di copia che si basano su di esso. Io ho appena provato questo file (che hai allegato nell'ultimo post), che non ha nomi di range definiti, e i file derivati non hanno collegamenti da disattivare. Quando premo "salva Excel e PDF" tutto gira perfettamente, e se apro un file derivato non ci sono collegamenti.

                            Non capisco questo tuo passaggio:

                            FROST220684 ha scritto:

                            voi ne vedete 2 ma sono migliaia e quindi è impossibile farlo uno ad uno.

                            hai già creato migliaia di preventivi e tutti hanno lo stesso problema? e non hai cercato di risolverlo in qualche modo?

                            #36569 Score: 0 | Risposta

                            vecchio frac
                            Senior Moderator
                              272 pts

                              Comunque propongo di tagliare la testa al toro (povero toro 🙂 ) e di eliminare i links già al momento della creazione del workbook derivato.
                              Nel codice di save_as aggiungi le righe necessarie una volta creato il Workbook che ospiterà la copia dell'originale:

                                  wb2.SaveAs p & "\Preventivi EXCEL\" & Replace(s, "/", "-") & ".xlsx", FileFormat:=xlWorkbookDefault
                                  ' inserire il nome della cartella preventivi PDF al posto di Preventivi Excel
                                  
                                  For Each v In wb2.LinkSources(Type:=xlLinkTypeExcelLinks)
                                      wb2.BreakLink Name:=v, Type:=xlLinkTypeExcelLinks
                                  Next
                                  
                                  With wb2.Worksheets("Output")
                              .
                              .
                              .
                              #36574 Score: 0 | Risposta

                              FROST220684
                              Partecipante

                                il toro c'è rimasto male    la soluzione è perfetta sei sempre geniale  . ora permangono alcuni problemi:

                                1. ho una cartella con tantissimi preventivi fatti con il file senza il codice aggiuntivo che chiaramente per essere esportati e non dare errore devono essere senza collegamenti. secondo te come posso risolvere? stavo pensando ad una macro che faccia una copia di tutti i preventivi nella cartella con la stessa teoria del codice aggiunto faccio copia ed elimino collegamenti che ne pensi?

                                vecchio frac ha scritto:

                                hai già creato migliaia di preventivi e tutti hanno lo stesso problema? e non hai cercato di risolverlo in qualche modo?

                                purtroppo il problema si è visto solo quando ho creato il file Database non prima. non mi sono posto il problema perchè l'errore c'è stato sull'altro file.

                                2. quando esporto i dati dai preventivi della cartella nel file database lui li aggiunge a prescindere. avrei bisogno di qualcosa che escluda quelli precedentemente estratti. non so se mi sono spiegato.

                                #36575 Score: 0 | Risposta

                                vecchio frac
                                Senior Moderator
                                  272 pts

                                  1) Non lo vedo come un gran problema e come pensavi giustamente, una piccola macro farà il suo dovere.
                                  Preparati una macro a parte con poche righe di codice che passa in rassegna tutti i file della cartella, li apre, elimina i collegamenti (col codice appena visto), salva, chiude e passa al prossimo file. Una volta lanciata la macro e terminato il suo compito, la puoi eliminare. Naturalmente devi farti prima una copia di sicurezza della cartella... non sto qui a spiegarti l'importanza del backup 🙂

                                  2) Se è così, la procedura file_riassuntivo è leggermente da rivedere (l'hai scritta tu?   ) perchè dovrai passare in rassegna cella per cella del file da cui copiare e vedere che già non sia presente nel file di destinazione, se non c'è la si copia altrimenti no. Vuoi cimentarti nell'impresa? 🙂

                                  #36576 Score: 0 | Risposta

                                  FROST220684
                                  Partecipante

                                    vecchio frac ha scritto:

                                    1) Non lo vedo come un gran problema e come pensavi giustamente, una piccola macro farà il suo dovere. Preparati una macro a parte con poche righe di codice che passa in rassegna tutti i file della cartella, li apre, elimina i collegamenti (col codice appena visto), salva, chiude e passa al prossimo file. Una volta lanciata la macro e terminato il suo compito, la puoi eliminare. Naturalmente devi farti prima una copia di sicurezza della cartella... non sto qui a spiegarti l'importanza del backup

                                    eh si a pensare so proprio bravo ad agire un po meno    il problema ce l'ho sulla stesura del codice perchè come faccio a dirgli di aprire tutti i file della cartella???    un aiutinoooooo? oltre ai 1000 che mi hai dato   ho provato questo sotto ma non va   

                                    Sub OperaInDirectory()
                                        Const MYFOLDER = "C:\Users\Anna\Desktop\Nuova cartella\"
                                        Dim sFileName As String
                                        sFileName = Dir(MYFOLDER & "*.xlsx")
                                        Do While sFileName <> ""
                                            'UtImportaLIF (MYFOLDER & sFileName)
                                            sFileName = Dir
                                            Workbooks.Open Filename:=MYFOLDER & sFileName
                                            For Each v In wb2.LinkSources(Type:=xlLinkTypeExcelLinks)
                                            wb2.BreakLink Name:=v, Type:=xlLinkTypeExcelLinks
                                        Next
                                            ActiveWorkbook.Save
                                            ActiveWindow.Close
                                        Loop
                                    
                                    End Sub
                                    

                                    vecchio frac ha scritto:

                                    2) Se è così, la procedura file_riassuntivo è leggermente da rivedere (l'hai scritta tu?   ) perchè dovrai passare in rassegna cella per cella del file da cui copiare e vedere che già non sia presente nel file di destinazione, se non c'è la si copia altrimenti no. Vuoi cimentarti nell'impresa? 🙂

                                    no non l'ho scritta io    troppo complicato    in alternativa si potrebbe aggiungere qualche riga che fa questo. Estrapolo i dati con il codice che già c'è e sposto tutti i file analizzati in una cartella Preventivi Esportati. un aiutinooooo?

                                    #36579 Score: 0 | Risposta

                                    vecchio frac
                                    Senior Moderator
                                      272 pts

                                         

                                      Sub 1, se guardi attentamente il codice della routine file_riassuntivo, ti dice parecchio su come passare in rassegna una cartella di file. Anzi il cuore della faccenda è praticamente lì.

                                      Rozzamente una cosa così.

                                      Option Explicit
                                      
                                      Sub file_riassuntivo()
                                      Dim percorso As String
                                      Dim nomeFile As String
                                      Dim wb1 As Workbook
                                      Dim wb2 As Workbook
                                      Dim sh As Worksheet
                                      Dim uR As Long
                                      Dim s As String
                                      Dim t As String
                                      Dim r As Range
                                      Dim bOk As Boolean
                                      Dim ce As Range
                                      
                                          Application.ScreenUpdating = False
                                          Application.DisplayAlerts = False
                                          Set wb1 = ThisWorkbook
                                          percorso = "C:\Users\franz\Desktop\Preventivi Excel\"
                                          nomeFile = Dir(percorso)
                                          Do While nomeFile <> ""
                                              If nomeFile <> wb1.Name Then
                                                  Set wb2 = Application.Workbooks.Open(percorso & nomeFile)
                                                  Set sh = wb2.Worksheets("Input")
                                                  bOk = True
                                                  
                                                  With wb1.Worksheets("Database")
                                                      uR = Application.CountA(.Range("A:A"))
                                                      s = Join(Application.Transpose(sh.Range("B1:B11")))
                                                  
                                                      For Each ce In .Range("B2:B" & uR)
                                                          Set r = .Range(.Cells(ce.Row, "B"), .Cells(ce.Row, "L"))
                                                          t = Join(Application.Transpose(Application.Transpose(r)))
                                                          bOk = StrComp(s, t, vbTextCompare) <> 0
                                                      Next
                                                      If bOk Then
                                                          .Range("A" & uR + 1) = uR
                                                          sh.Range("B1:B11").Copy
                                                          .Range("B" & uR + 1).PasteSpecial Transpose:=True
                                                      End If
                                                  End With
                                                  wb2.Close False
                                                  
                                              End If
                                              nomeFile = Dir
                                          Loop
                                          Application.ScreenUpdating = True
                                          Application.DisplayAlerts = True
                                          MsgBox "Fatto"
                                          
                                      End Sub
                                      #36580 Score: 0 | Risposta

                                      vecchio frac
                                      Senior Moderator
                                        272 pts

                                        FROST220684 ha scritto:

                                        Sub OperaInDirectory()

                                        Bè ma vedi che ti riferisci a wb2.LinkSources e wb2.BreakLink citando una variabile Workbook "wb2" che non è mai stata dichiarata nè associata ad alcun oggetto (wb2 da dove salta fuori, in questo pezzo di codice?). Forza che questa la puoi risolvere 🙂 Il resto del codice è corretto.

                                        #36612 Score: 0 | Risposta

                                        FROST220684
                                        Partecipante

                                          vecchio frac ha scritto:

                                          Bè ma vedi che ti riferisci a wb2.LinkSources e wb2.BreakLink citando una variabile Workbook "wb2" che non è mai stata dichiarata nè associata ad alcun oggetto (wb2 da dove salta fuori, in questo pezzo di codice?). Forza che questa la puoi risolvere 🙂 Il resto del codice è corretto.

                                          allora ho provato cosi, sembra funzionare nel senso che non da nessun errore ma gira all'infinito la rotellina e mi costringe a forzare arresto

                                          Option Explicit
                                          
                                          Sub file_riassuntivo()
                                          Dim percorso As String
                                          Dim nomeFile As String
                                          Dim wb1 As Workbook
                                          Dim wb2 As Workbook
                                          Dim sh As Worksheet
                                          Dim uR As Long
                                          Dim s As String
                                          Dim t As String
                                          Dim r As Range
                                          Dim bOk As Boolean
                                          Dim ce As Range
                                          Dim v As Variant
                                          
                                              Application.ScreenUpdating = False
                                              Application.DisplayAlerts = False
                                              Set wb1 = ThisWorkbook
                                              percorso = "C:\Users\Anna\Desktop\Nuova cartella\"
                                              nomeFile = Dir(percorso)
                                              Do While nomeFile <> ""
                                                  If nomeFile <> wb1.Name Then
                                                      Set wb2 = Application.Workbooks.Open(percorso & nomeFile)
                                                      Set sh = wb2.Worksheets("Input")
                                                      bOk = True
                                                      End If
                                                      Loop
                                                      
                                                      For Each v In wb2.LinkSources(Type:=xlLinkTypeExcelLinks)
                                                  wb2.BreakLink Name:=v, Type:=xlLinkTypeExcelLinks
                                              Next
                                              
                                              With wb2.Worksheets("Output")
                                                      wb2.Close False
                                                      
                                                  nomeFile = Dir
                                              Application.ScreenUpdating = True
                                              Application.DisplayAlerts = True
                                              MsgBox "Fatto"
                                              End With
                                          
                                          End Sub
                                          

                                          ho provato cosi e nemmeno

                                          Option Explicit
                                          
                                          Sub OperaInDirectory()
                                          Dim v As Variant
                                          Dim wb1 As Workbook
                                          Dim wb2 As Workbook
                                          Set wb1 = ThisWorkbook
                                              Set wb2 = Workbooks.Add
                                              Const MYFOLDER = "C:\Users\Anna\Desktop\Nuova cartella\"
                                              Dim sFileName As String
                                              sFileName = Dir(MYFOLDER & "*.xlsx")
                                              Do While sFileName <> ""
                                                  'UtImportaLIF (MYFOLDER & sFileName)
                                                  sFileName = Dir
                                                  Workbooks.Open Filename:=MYFOLDER & sFileName
                                                  For Each v In wb2.LinkSources(Type:=xlLinkTypeExcelLinks)
                                                  wb2.BreakLink Name:=v, Type:=xlLinkTypeExcelLinks
                                              Next
                                                  ActiveWorkbook.Save
                                                  ActiveWindow.Close
                                              Loop
                                          
                                          End Sub

                                          mi arrendo    sinceramente mi sa che mi sono perso nei commenti e non so cosa si è risposto a cosa  

                                          Edit by VF: sistemato il contenuto che si era formattato male

                                          #36617 Score: 0 | Risposta

                                          vecchio frac
                                          Senior Moderator
                                            272 pts

                                            FROST220684 ha scritto:

                                            ma gira all'infinito la rotellina e mi costringe a forzare arresto

                                            Il codice che hai postato non è come il mio, che funziona l'ho appena provato in una cartella di test.
                                            Lo riscrivo con la nuova parte che interrompe i collegamenti.

                                            Option Explicit
                                            
                                            Sub file_riassuntivo()
                                            Dim percorso As String
                                            Dim nomeFile As String
                                            Dim wb1 As Workbook
                                            Dim wb2 As Workbook
                                            Dim sh As Worksheet
                                            Dim uR As Long
                                            Dim s As String
                                            Dim t As String
                                            Dim r As Range
                                            Dim bOk As Boolean
                                            Dim ce As Range
                                            Dim v As Variant
                                            
                                                Application.ScreenUpdating = False
                                                Application.DisplayAlerts = False
                                                Set wb1 = ThisWorkbook
                                                percorso = "C:\Users\franz\Desktop\Preventivi Excel\"
                                                nomeFile = Dir(percorso)
                                                Do While nomeFile <> ""
                                                    If nomeFile <> wb1.Name Then
                                                        Set wb2 = Application.Workbooks.Open(percorso & nomeFile)
                                                        Set sh = wb2.Worksheets("Input")
                                                        bOk = True
                                                        
                                                        For Each v In wb2.LinkSources(Type:=xlLinkTypeExcelLinks)
                                                            wb2.BreakLink Name:=v, Type:=xlLinkTypeExcelLinks
                                                        Next
                                                        
                                                        With wb1.Worksheets("Database")
                                                            uR = Application.CountA(.Range("A:A"))
                                                            s = Join(Application.Transpose(sh.Range("B1:B11")))
                                                        
                                                            For Each ce In .Range("B2:B" & uR)
                                                                Set r = .Range(.Cells(ce.Row, "B"), .Cells(ce.Row, "L"))
                                                                t = Join(Application.Transpose(Application.Transpose(r)))
                                                                bOk = StrComp(s, t, vbTextCompare) <> 0
                                                            Next
                                                            If bOk Then
                                                                .Range("A" & uR + 1) = uR
                                                                sh.Range("B1:B11").Copy
                                                                .Range("B" & uR + 1).PasteSpecial Transpose:=True
                                                            End If
                                                        End With
                                                        wb2.Close True
                                                        
                                                    End If
                                                    nomeFile = Dir
                                                Loop
                                                Application.ScreenUpdating = True
                                                Application.DisplayAlerts = True
                                                MsgBox "Fatto"
                                                
                                            End Sub
                                            
                                            #36620 Score: 0 | Risposta

                                            FROST220684
                                            Partecipante

                                              io ho l'impressione che mi sono perso nei commenti e non riesco più a capire nulla. questo codice che hai postato almeno da quello che mi sembra svolge queste funzioni:

                                              1. apre i file elimina i collegamenti

                                              2. esporta i dati richiesti

                                              3. chiude e salva i file?

                                              correggimi se sbaglio che sto andando in confusione. se io metto questa macro nel file database mi da questo errore in allegato.

                                              ad ogni modo non riusciamo a capirci perchè io ho scollegato le cose perche il codice che elimina i collegamenti l'ho già inserito nel file che crea i preventivi e funziona benissimo.

                                              adesso a me servirebbe un codice una tantum che mi apre i preventivi in cartella ed elimina i collegamenti dai vecchi preventivi perche quelli nuovi ormai sono apposto

                                              cmq hai una pazienza davvero superlativa hahaahhaha   scusami ma secondo me non ci sto capendo più niente

                                              Allegati:
                                              You must be logged in to view attached files.
                                              #36625 Score: 0 | Risposta

                                              vecchio frac
                                              Senior Moderator
                                                272 pts

                                                Uh? Mi accorgo che non si è inserito il mio ultimo post.
                                                Dicevo che non è colpa tua, ed in effetti c'è qualche errore nel mio codice. Rimedio con una versione completa, da eseguire separatamente al resto:

                                                Sub OperaInDirectory()
                                                Dim v As Variant
                                                Dim wb1 As Workbook
                                                Dim sFileName As String
                                                
                                                Const MYFOLDER = "C:\Users\franz\Desktop\Nuova cartella\"
                                                
                                                    On Error GoTo gest_err
                                                    
                                                    Set wb1 = ThisWorkbook
                                                    sFileName = Dir(MYFOLDER & "*.xlsx")
                                                    
                                                    Do While Len(sFileName) > 0
                                                        Workbooks.Open Filename:=MYFOLDER & sFileName
                                                
                                                        With ActiveWorkbook
                                                            If .LinkSources(Type:=xlLinkTypeExcelLinks) = "" Then
                                                                .Close False
                                                            End If
                                                        End With
                                                resume_here:
                                                        sFileName = Dir
                                                    Loop
                                                    
                                                    Exit Sub
                                                
                                                gest_err:
                                                    With ActiveWorkbook
                                                        For Each v In .LinkSources(Type:=xlLinkTypeExcelLinks)
                                                            .BreakLink Name:=v, Type:=xlLinkTypeExcelLinks
                                                        Next
                                                        .Close True
                                                    End With
                                                    Resume resume_here
                                                    
                                                End Sub
                                                
                                                #36626 Score: 0 | Risposta

                                                FROST220684
                                                Partecipante

                                                  perfettooooooooo!!!!!!!! funziona alla grande.

                                                  ora invece su questo codice del file database riusciamo ad aggiungere qualche riga che fa spostare i file estrapolati dalla macro in un altra cartella? come per dire oggi estrapolo i dati di 10 preventivi e questi 10 preventivi li sposto da un altra parte. cosi da non creare copie dei dati?

                                                  Sub file_riassuntivo()
                                                      Application.DisplayAlerts = False
                                                      Application.ScreenUpdating = False
                                                      Dim percorso As String
                                                      Dim nomeFile As String
                                                      Dim WB As Workbook
                                                      Dim sh As Worksheet
                                                      percorso = "C:\Users\Anna\Desktop\Preventivi Excel\Nuova cartella\"
                                                      nomeFile = Dir(percorso)
                                                      Do While nomeFile <> ""
                                                          If nomeFile <> ThisWorkbook.Name Then
                                                              Set WB = Application.Workbooks.Open(percorso & nomeFile)
                                                              Set sh = WB.Worksheets(1)
                                                              sh.Range("B1:B11").Copy
                                                              ThisWorkbook.Sheets(1).Activate
                                                              uR = Cells(Rows.Count, 1).End(xlUp).Row + 1
                                                              If Cells(2, 1) = 1 Then
                                                                  Cells(uR, 1) = Cells(uR - 1, 1) + 1
                                                              Else
                                                                  Cells(2, 1) = 1
                                                              End If
                                                              Cells(uR, 2).PasteSpecial Paste:=xlValues, Transpose:=True
                                                              WB.Close False
                                                          End If
                                                          nomeFile = Dir
                                                      Loop
                                                      Application.ScreenUpdating = True
                                                      Application.DisplayAlerts = True
                                                      MsgBox "Dati Importati.", vbInformation, "OK"
                                                  End Sub
                                                  
                                                  #36627 Score: 0 | Risposta

                                                  vecchio frac
                                                  Senior Moderator
                                                    272 pts

                                                    Questa versione del codice de file del database non è l'ultima che ho proposto e che inserisce solo le righe dei preventivi non già presenti nel database stesso.
                                                    Vedi il post #36617 per l'ultima versione (che interrompe anche eventuali collegamenti).

                                                    Se ho capito male, allora spiegami la frase:

                                                    FROST220684 ha scritto:

                                                    come per dire oggi estrapolo i dati di 10 preventivi e questi 10 preventivi li sposto da un altra parte. cosi da non creare copie dei dati?

                                                    #36628 Score: 0 | Risposta

                                                    FROST220684
                                                    Partecipante

                                                      quindi tu dici che il codice postato nel #36617:

                                                      elimina i collegamenti - estrapola i dati - e se lo riuso salterà i dati estrapolati precedentemente?

                                                      se è cosi potrebbe andare benissimo il problema però è che mi da sempre l'errore che ho postato prima nel #36620 ti riallego immagine a cui tu poi mi hai risposto con un codice diverso che funziona ma va usato separatamente.

                                                      ti spiego la frase cmq: a me andrebbe bene mettere tutti i preventivi fatti nella cartella ed estrapolare i dati. l'unica cosa che dovrebbe fare alla fine dell'estrapolazione è spostare tutti i file in una sottocartella "File Gia' Esportati" che secondo me sarebbe la soluzione migliore dato che ci troviamo a questo punto e manca solo il codice che sposta i file in un altra cartella perchè il resto funziona

                                                      Allegati:
                                                      You must be logged in to view attached files.
                                                    Login Registrati
                                                    Stai vedendo 25 articoli - dal 1 a 25 (di 50 totali)
                                                    Rispondi a: Estrazione celle da piu file nella stessa cartella
                                                    Gli allegati sono permessi solo ad utenti REGISTRATI
                                                    Le tue informazioni: