0
votes

Thanks in advance for your help and comments.

I have the following problem, but I do not know if it is possible ... I am trying to rename PDF files that are in the folder C: \ ... I need to rename according to a worksheet that I have in excel that is ordered according to the pdf files .. I would like to rename with the spreadsheet data in excel?

I have a code that I researched but it does not search my database, but it asks me to enter the name of each file

Public Sub lsSelecionaArquivo() Dim Caminho As String Dim NomeBase As String

Caminho = InputBox("Informe o local dos arquivos a serem renomeados:", "Pasta", "C:\TEMP")
NomeBase = InputBox("Informe o local dos arquivos a serem renomeados:", "Renomear", "")


lsRenomearArquivos Caminho, NomeBase

End Sub

Public Sub lsRenomearArquivos(Caminho As String, NomeBase As String)

Dim FSO As Object, Pasta As Object, Arquivo As Object, Arquivos As Object
Dim Linha As Long
Dim lSeq As Long
Dim lNovoNome As String

Set FSO = CreateObject("Scripting.FileSystemObject")

If Not FSO.FolderExists(Caminho) Then
    MsgBox "A pasta '" & Caminho & "' não existe.", vbCritical, "Erro"
    Exit Sub
End If

lSeq = 1

Set Pasta = FSO.GetFolder(Caminho)
Set Arquivos = Pasta.Files

Cells(1, 1) = "De"
Cells(1, 2) = "Para"

Linha = 2

For Each Arquivo In Arquivos

    Cells(Linha, 1) = UCase$(Arquivo.Path)
    lNovoNome = Caminho & "\" & NomeBase & lSeq & Right(Arquivo, 4)
    Name Arquivo.Path As lNovoNome

    Cells(Linha, 2) = lNovoNome
    lSeq = lSeq + 1
    Linha = Linha + 1

Next

End Sub

2

2 Answers

0
votes

For the renaming part, consider this.

Sub RenameFiles()
'Updateby20141124
Dim xDir As String
Dim xFile As String
Dim xRow As Long
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
If .Show = -1 Then
    xDir = .SelectedItems(1)
    xFile = Dir(xDir & Application.PathSeparator & "*")
    Do Until xFile = ""
        xRow = 0
        On Error Resume Next
        xRow = Application.Match(xFile, Range("A:A"), 0)
        If xRow > 0 Then
            Name xDir & Application.PathSeparator & xFile As _
            xDir & Application.PathSeparator & Cells(xRow, "B").Value
        End If
        xFile = Dir
    Loop
End If
End With
End Sub

https://www.extendoffice.com/documents/excel/2339-excel-rename-files-in-a-folder.html

Also, consider this.

Sub ListFiles()
Dim MyFolder As String
Dim MyFile As String
Dim j As Integer
MyFolder = "C:\DealerExam"
MyFile = Dir(MyFolder & "\*.*")
a = 0
Do While MyFile <> ""
    a = a + 1
    Cells(a, 1).Value = MyFile
    MyFile = Dir
Loop
End Sub

This will list all the files in your directory starting in cell 'A1'

0
votes

Thanks for the help

It is a bit tense to change language since I study Java and started doing VBA.

When I ran the code, I saw that it is necessary for the spreadsheet to have the old file name and the new one to insert the data, but there is no way to get it to just get the new data? And I've tried searching on how to make them as PDF without having to put the file extension in the worksheet.

Sorry for the questions ... I do not have much contact with VBA.

I thank you very much for helping me.

Sub RenameFiles()

Dim xDir As String
Dim xFile As String
Dim xRow As Long
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
If .Show = -1 Then
    xDir = .SelectedItems(1)
    xFile = Dir(xDir & Application.PathSeparator & "*")
    Do Until xFile = ""
        xRow = 0
        On Error Resume Next
        xRow = Application.Match(xFile, Range("A:A"), 0)
        If xRow > 0 Then
            Name xDir & Application.PathSeparator & xFile As _
            xDir & Application.PathSeparator & Cells(xRow, "B").Value
        End If
        xFile = Dir
    Loop
End If
End With
End Sub

Sub ListFiles()
Dim MyFolder As String
Dim MyFile As String
Dim j As Integer
MyFolder = "C:\Users\AnaWill\Desktop\Holerites Folha\Nova pasta"
MyFile = Dir(MyFolder & "\*.*")
a = 0
Do While MyFile <> ""
    a = a + 1
    Cells(a, 2).Value = MyFile
    MyFile = Dir
Loop
End Sub