You are here:---Rispondi a: [RISOLTO] Rinominare dei file secondo un determinato criterio
Rispondi a: [RISOLTO] Rinominare dei file secondo un determinato criterio2018-05-06T12:24:58+02:00

Home Forum Domande su Excel VBA e MACRO [RISOLTO] Rinominare dei file secondo un determinato criterio Rispondi a: [RISOLTO] Rinominare dei file secondo un determinato criterio

BySalvBySalv
Amministratore del forum
    Post totali: 512

    Ciao micky eccoti il solito file l’ho adattato inserendo il pulsante per la rinomina dei file.

    “ATTENZIONE” visto che fa la ricerca anche nelle sottocartelle controlla dopo la ricerca se ci sono sottocartelle che non interessano e cancellale con il relativo file.

    ho creato dei file fittizi, questa la schermata della ricerca

    Cattura
    image upload no limit

    la prima cosa e scegliere la cartella della ricerca con il doppioclick in “A2”, poi impostare l’estensione in “pdf” e togliere eventuali dati in “A3” e “B2” mettendo anche “NO” per i link

    a questo punto vedi che alcuni pdf mancano della lettera di riferimento che hai detto, ora puoi premere il pulsante “Rinomina” ti esce un “InputBox” che ti chiede quale lettera vuoi intercalare prima di “.pdf” come vedi dall’immagine io ho inserito una “m” e poi ho confermato, ma è a piacere.

    Cattura
    screen shot

    alla fine ho fatto una nuova ricerca per vedere il risultato, ed ecco il risultato finale, che come vedi ha inserito la “m” dove serviva, tenendo sempre conto che i file sono nominati in quella maniera, altrimenti la macro va modificata per adattarla al nuovo nome.

    Cattura3

    Questa l’ultima revisione della Macro

    Sub rinoma()
    Dim Odd, Nww, r, x, d, k, k1, ind, est, risp
    
    est = "." & Cells(2, 3)
    risp = InputBox("Inserire la lettera da intercalare prima di ""." & est & """", "Rinomina file")
    If risp = "" Then Exit Sub
    k1 = Len(est)
    If Cells(4, 1) = "" Then Exit Sub Else r = Cells(Rows.Count, 2).End(xlUp).Row
    For x = 4 To r
    ind = Cells(x, 1)
    d = Cells(x, 2)
    Odd = ind & d
    k = Len(d) - k1
    If k > 9 Then GoTo 1
    d = Mid(d, 1, k) & "." & risp & est
    Nww = ind & d
    Name Odd As Nww
    1 Next x
    End Sub

    questo il link per il file.

    https://mega.nz/#!FVcGCJaJ!Hpe5m0B12feJ4KY6q5hA5f5_zsrsZeDY-S66APPL4f8

    Ciao By Sal  :bye:

     

    Utilizzando il sito, accetti l'utilizzo dei cookie da parte nostra. maggiori informazioni

    Questo sito utilizza i cookie per fornire la migliore esperienza di navigazione possibile. Continuando a utilizzare questo sito senza modificare le impostazioni dei cookie o cliccando su "Accetta" permetti il loro utilizzo.

    Chiudi