Question

提前感谢您的帮助和意见。

我有以下问题，但我不知道是否可能......我正在尝试重命名文件夹C：\ ...中的PDF文件我需要根据我的工作表重命名在excel中根据pdf文件排序..我想用excel中的电子表格数据重命名？

我有一个我研究过的代码，但它没有搜索我的数据库，但它要求我输入每个文件的名称

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 &#39;" & Caminho & "&#39; 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

Answer 1

对于重命名部分，请考虑这一点。

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

另外，请考虑这一点。

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

这将列出目录中从单元格“A1”

开始的所有文件

Answer 2

感谢您的帮助

自从我学习Java并开始做VBA以来，改变语言有点紧张。

当我运行代码时，我发现电子表格有必要使用旧文件名和新文件名来插入数据，但是没有办法让它获取新数据？我已经尝试搜索如何将它们设为PDF而无需将文件扩展名放在工作表中。

很抱歉这些问题......我与VBA没什么联系。

我非常感谢你帮助我。

＆＃13;

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

＆＃13;

如何重命名使用excel database vba

2 个答案: