salvare file pdf con nome preso da elenco Excel

Question

Buonasera a tutti,

eseguendo questa macro mi rinomina i file nella cartella in Excel ma non mi mantiene l'ordine delle celle.

Dove sbaglio?

grazie a tutti se mi potete aiutare...

Option Explicit

'--------->>

Public Sub Tester()

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim RngTabella As Range

    Dim oFso As Object

    Dim oFolder As Object

    Dim oFiles As Object

    Dim oFile As Object

    Dim sPath As String, sStr As String, sName As String

    Dim i As Long, j As Long, k As Long

    Dim iCtr As Long, jCtr As Long

        Const sPercorso As String =  _

                        "C:\Users\Giuseppe\AAA_Files"       '<<=== Modifica

    Const sFoglio As String = "Foglio1"                       '<<=== Modifica

    Const sTabella As String = "A1:B20"                     '<<=== Modifica

    Const sExt As String = ".PDF"

    Set WB = ThisWorkbook

    Set SH = WB.Sheets(sFoglio)

    Set RngTabella = SH.Range(sTabella)

    sStr = Application.PathSeparator

    If Right(sPercorso, 1) = sStr Then

        sPath = sPercorso

    Else

        sPath = sPercorso & sStr

    End If

    Set oFso = CreateObject("Scripting.FileSystemObject")

    Set oFolder = oFso.GetFolder(sPath)

    Set oFiles = oFolder.Files

    For Each oFile In oFiles

        With oFile

            If UCase(Right(.Name, 4)) = sExt Then

                iCtr = iCtr + 1

                sName = RngTabella.Cells(iCtr, 1) & "_" _

                                    & RngTabella.Cells(iCtr, 2).Value

                .Name = sName & sExt

            End If

        End With

    Next oFile

        Call MsgBox( _

             Prompt:=iCtr & " File sono stati renominati", _

             Buttons:=vbInformation, _

             Title:="REPORT")

End Sub

'<<=========

Answer 1

Ciao Mirko,

Ciao, ti ringrazio per l' aiuto ma mi restituisce il seguente errore.

   For i = 1 To UBound(arrIn)

        sOldName = sPath & arrIn(1, 1)

        sNewName = sPath & arrIn(1, 2)

        Name sOldName As sNewName

    Next i

        Call MsgBox(Prompt:="Fatto", _

                           Buttons:=vbInformation, _

                         Title:="REPORT")

Non so cosa potrebbe essere il problema.

Il tuo errore (Errore di runtime 52 o Errore di runtime 53 ?) Indicherebbe che almeno uno dei vecchi nomi di file non è stato trovato o che il nuovo nome non è un nome di file valido.

Per verificare quale errore si applica, e quali file sono stati correttamente rinominati, esegui la seguente procedura e quindi verifica le informazioni nella colonna C del nuovo foglio REPORT:

'========>>

Option Explicit

'-------->>

Public Sub Tester()

    Dim WB As Workbook

    Dim SH As Worksheet, SH_Report As Worksheet

    Dim Rng As Range

    Dim arrIn() As Variant

    Dim sPath As String, sStr As String

    Dim sOldName As String, sNewName As String

    Dim s1 As String, s2 As String

    Dim i As Long

    Const sFoglio As String = "Foglio1"                           '<<=== Modifica

    Const sElenco As String = "A2:B460"                         '<<=== Modific a

    Const sPercorso As String = "C:\Users\Pippo"         '<<=== Modifica

    Set WB = ThisWorkbook

    Set SH = WB.Sheets(sFoglio)

    Set Rng = SH.Range(sElenco)

    arrIn = Rng.Value

    ReDim Preserve arrIn(1 To UBound(arrIn), 1 To 3)

    sStr = Application.PathSeparator

    If Right(sPercorso, 1) = sStr Then

        sPath = sPercorso

    Else

        sPath = sPercorso & sStr

    End If

    For i = 1 To UBound(arrIn)

        sOldName = sPath & arrIn(i, 1)

        sNewName = sPath & arrIn(i, 2)

        s1 = Dir(sOldName)

        s2 = Dir(sNewName)

        If s1 = vbNullString Then

            If s2 = vbNullString Then

                arrIn(i, 3) = "il file " & sPath & arrIn(1, 1) & " non e' stato trovato"

            Else

                arrIn(i, 3) = "File rinominato correttamente"

            End If

        Else

            On Error Resume Next

            Name sOldName As sNewName

            If Err.Number = 52 Then

                arrIn(i, 3) = "il nome " & arrIn(1, 2) & " non e' valido!"

                On Error GoTo 0

            ElseIf Err.Number = 0 Then

                arrIn(i, 3) = "File rinominato correttamente"

            End If

        End If

    Next i

    Set SH_Report = WB.Sheets.Add(Before:=WB.Sheets(1))

    With SH_Report

        .Name = "REPORT"

        .Range("A1").Value = "Vecchio Nome"

        .Range("B1").Value = "Nuovo nome"

        Range("C1").Value = "Risultato"

        .Range("A2").Resize(UBound(arrIn), 3).Value = arrIn

        .Columns("A:C").AutoFit

    End With

    Call MsgBox(Prompt:="Fatto", _

    Buttons:=vbInformation, _

    Title:="REPORT")

End Sub

'<<========

===

Regards,

Norman

Answer 2

Ciao Mirko,

questa macro era quella che avevi fatto nel 2017,  in una cartella ho 460 file che devo rinominare in base ad un elenco in Excel, metto in ordine i file che sono nominati in ordine alfabetico e ordino il nelle mie celle Excel dalla cella A1:B460, quando lancio la macro, vengono rinominati i file ma non in ordine come erano state messi, mi ritrovo che i file vengono rinominati in ordine sparsi ma non mentendo l' ordine che avevo dato.

Riesci a darmi una mano?

Prova:

'========>>

Option Explicit

'-------->>

Public Sub Tester()

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim Rng As Range

    Dim arrIn As Variant

    Dim sPath As String, sStr As String

    Dim sOldName As String, sNewName As String

    Dim i As Long

    Const sFoglio As String = "Foglio1"                          '<<=== Modifica

    Const sElenco As String = "A2:B460"                        '<<=== Modifica

    Const sPercorso As String = "C:\Users\Pippo"        '<<=== Modifica

    Set WB = ThisWorkbook

    Set SH = WB.Sheets(sFoglio)

    Set Rng = SH.Range(sElenco)

    arrIn = Rng.Value

    sStr = Application.PathSeparator

    If Right(sPercorso, 1) = sStr Then

        sPath = sPercorso

    Else

        sPath = sPercorso & sStr

    End If

    For i = 1 To UBound(arrIn)

        sOldName =sPath &  arrIn(1, 1)

        sNewName =sPath & arrIn(1, 2)

        Name sOldName As sNewName

    Next i

        Call MsgBox(Prompt:="Fatto", _

                           Buttons:=vbInformation, _

                         Title:="REPORT")

End Sub

'<<========

===

Regards,

Norman

Answer 3

Ciao, ti ringrazio per l' aiuto ma mi restituisce il seguente errore.

   For i = 1 To UBound(arrIn)

        sOldName = sPath & arrIn(1, 1)

        sNewName = sPath & arrIn(1, 2)

        Name sOldName As sNewName

    Next i

        Call MsgBox(Prompt:="Fatto", _

                           Buttons:=vbInformation, _

                         Title:="REPORT")

Non so cosa potrebbe essere il problema.

Grazie Mirko

Answer 4

Ciao Norman,

questa macro era quella che avevi fatto nel 2017,  in una cartella ho 460 file che devo rinominare in base ad un elenco in Excel, metto in ordine i file che sono nominati in ordine alfabetico e ordino il nelle mie celle Excel dalla cella A1:B460, quando lancio la macro, vengono rinominati i file ma non in ordine come erano state messi, mi ritrovo che i file vengono rinominati in ordine sparsi ma non mentendo l' ordine che avevo dato.

Riesci a darmi una mano?

Ti ringrazio e auguro buon anno...

Mirko

Answer 5

Ciao gmirko,

eseguendo questa macro mi rinomina i file nella cartella in Excel ma non mi mantiene l'ordine delle celle.

Dove sbaglio?

[...]

Riconosco la procedura ma non capisco il tuo problema. Forse sarebbe utile una spiegazione più dettagliata.

===

Regards,

Norman