Dim objFSO,objFilesFolder,objFile,objFilesList
Set objFSO=CreateObject("Scripting.FileSystemObject")
Set objFilesList=objFSO.OpenTextFile("fileslist.txt", 2 ,True)
Set objFilesFolder=objFSO.GetFolder("C:\Temp\Temporary")
For Each objFile in objFilesFolder.Files
    objFilesList.WriteLine objFile.Path
Next
objFilesList.Close
Set objFile=Nothing
Set objFilesList=Nothing
Set objFilesFolder=Nothing
Set objFSO=Nothing
WScript.Echo "Files list are ready!"

C:\Temp\Temporary\AUTOEXEC. 001 	AUTOEXEC.TXT
C:\Temp\Temporary\AUTOEXEC.BAT	AUTOEXEC.CMD
C:\Temp\Temporary\autorun.inf	autorun.DOC

Option Explicit
Dim objFSO,objFilesList,objFile
Dim strTemp,strTempArr
Set objFSO=CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists("fileslist.txt") Then
	Set objFilesList=objFSO.OpenTextFile("fileslist.txt", 1 )
	Do While Not objFilesList.AtEndOfStream
		strTemp=objFilesList.ReadLine
		strTempArr=Split(strTemp,vbTab)
		If UBound(strTempArr)> 0  Then
			Set objFile=objFSO.GetFile(strTempArr( 0 ))
			objFile.Name=strTempArr( 1 )
		End If
	Loop
	Set objFile=Nothing
	Set objFilesList=Nothing
End If
Set objFSO=Nothing

Option Explicit
Sub test2()
    Dim x As String
    Dim fName As String
    Dim oldPath As String
    Dim newPath As String
    Dim i As Long
    
    oldPath = "C:\temp\"
    newPath = oldPath & "New\"
    On Error Resume Next
    x = GetAttr(newPath) And  0 
    If Err.Number <>  0  Then MkDir newPath
    fName = Dir(oldPath & "*.pdf")
    With ActiveSheet
        Do While Len(fName) >  0 
            i = i +  1 
            FileCopy oldPath & fName, newPath & .Cells(i,  1 )
            '.Cells(i, 2) = oldPath & fName 'проверка
            'Kill oldPath & fName 'удаление старых
            fName = Dir
        Loop
    End With
End Sub