如何重命名多個pdf文件使用excel數據庫vba

Question

在此先感謝您的幫助和意見。

我有以下問題，但我不知道是否有可能...我試圖重命名文件夾C中的PDF文件：\ ...我需要根據工作表重命名我在excel中，根據pdf文件進行排序..我想用excel中的電子表格數據進行重命名？

我有我研究一個代碼，但它不搜索我的數據庫，但它要求我輸入的每個文件

公用Sub lsSelecionaArquivo（） 昏暗Caminho作爲字符串 昏暗NomeBase的名稱作爲字符串

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 

結束子

公用Sub lsRenomearArquivos（Caminho作爲字符串，NomeBase作爲字符串）

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

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。

我非常感謝你幫助我。

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