Create List of Files and dump in Column A:
Function MeListFiles(ByVal sPath As String)
'Source: https://stackoverflow.com/questions/31414106/get-list-of-excel-files-in-a-folder-using-vba
'Call Function Example: [MeListFiles ("P:\Folder\SubFolder1\Subfolder2\Subfolder3\Subfolder4\")]
Dim iLoop As Long
Dim oFile As Object, oFSO As Object, oFolder As Object, oFiles As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(sPath)
Set oFiles = oFolder.Files
iLoop = 2
For Each oFile In oFiles
ActiveSheet.Cells(iLoop, 1) = oFile.Name
iLoop = iLoop + 1
Next
End Function
'Source: https://stackoverflow.com/questions/31414106/get-list-of-excel-files-in-a-folder-using-vba
'Call Function Example: [MeListFiles ("P:\Folder\SubFolder1\Subfolder2\Subfolder3\Subfolder4\")]
Dim iLoop As Long
Dim oFile As Object, oFSO As Object, oFolder As Object, oFiles As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(sPath)
Set oFiles = oFolder.Files
iLoop = 2
For Each oFile In oFiles
ActiveSheet.Cells(iLoop, 1) = oFile.Name
iLoop = iLoop + 1
Next
End Function
|
|
Rename the files in Column A using the value in Column B:
Sub RenameFilesInList()
'Rename files in Column A using the value in Column B
'Source: https://www.mrexcel.com/forum/excel-questions/423149-using-excel-vba-rename-files-directory.html
'--------------------------------------------------------------------------------
Dim sCurrentFileName As String, sNewFileName As String
Dim iLoop As Long, iRe1 As Long
iRe1 = ActiveSheet.UsedRange.Rows.Count
'--------------------------------------------------------------------------------
For iLoop = 2 To iRe1
DoEvents
If Right(iLoop, 2) = "00" Then Application.StatusBar = iLoop & " & of " & iRe1
'-----------------------------------------
'Set File Name Strings (From/To)
sCurrentFileName = Cells(iLoop, 1).Value
sNewFileName = Cells(iLoop, 2).Value
'-----------------------------------------
'-----------------------------------------
'Rename each file
Dim sOldPathName As String
sOldPathName = sCurrentFileName
On Error Resume Next
Name sOldPathName As sNewFileName
'-----------------------------------------
Next iLoop
'--------------------------------------------------------------------------------
Application.StatusBar = ""
MsgBox "Finished"
End Sub
'Rename files in Column A using the value in Column B
'Source: https://www.mrexcel.com/forum/excel-questions/423149-using-excel-vba-rename-files-directory.html
'--------------------------------------------------------------------------------
Dim sCurrentFileName As String, sNewFileName As String
Dim iLoop As Long, iRe1 As Long
iRe1 = ActiveSheet.UsedRange.Rows.Count
'--------------------------------------------------------------------------------
For iLoop = 2 To iRe1
DoEvents
If Right(iLoop, 2) = "00" Then Application.StatusBar = iLoop & " & of " & iRe1
'-----------------------------------------
'Set File Name Strings (From/To)
sCurrentFileName = Cells(iLoop, 1).Value
sNewFileName = Cells(iLoop, 2).Value
'-----------------------------------------
'-----------------------------------------
'Rename each file
Dim sOldPathName As String
sOldPathName = sCurrentFileName
On Error Resume Next
Name sOldPathName As sNewFileName
'-----------------------------------------
Next iLoop
'--------------------------------------------------------------------------------
Application.StatusBar = ""
MsgBox "Finished"
End Sub
Alternate File Read Method: Untested
Excel Trick shows the explanation / includes the original code:
Public FSC as New FileSystemObject
'(Don't forget to set the reference to: Microsoft Scripting Runtime)
'Creating a FileSystemObject
Public FSO As New FileSystemObject
Sub CreateFile()
Dim TxtStr As TextStream
Dim FileName As String
Dim FileContent As String
Dim File As File
FileName = "C:\TestDirectory\File.txt" 'File to be created
'Creating a file and writing content to it
FileContent = InputBox("Enter the File Content")
If Len(FileContent) > 0 Then
Set TxtStr = FSO.CreateTextFile(FileName, True, True)
TxtStr.Write FileContent
TxtStr.Close
End If
' Reading from the file that we have just created
If FSO.FileExists(FileName) Then
Set File = FSO.GetFile(FileName)
Set TxtStr = File.OpenAsTextStream(ForReading, TristateUseDefault)
MsgBox TxtStr.ReadAll
TxtStr.Close
' Finally Deleting the File
'File.Delete (True)
End If
End Sub
Public FSC as New FileSystemObject
'(Don't forget to set the reference to: Microsoft Scripting Runtime)
'Creating a FileSystemObject
Public FSO As New FileSystemObject
Sub CreateFile()
Dim TxtStr As TextStream
Dim FileName As String
Dim FileContent As String
Dim File As File
FileName = "C:\TestDirectory\File.txt" 'File to be created
'Creating a file and writing content to it
FileContent = InputBox("Enter the File Content")
If Len(FileContent) > 0 Then
Set TxtStr = FSO.CreateTextFile(FileName, True, True)
TxtStr.Write FileContent
TxtStr.Close
End If
' Reading from the file that we have just created
If FSO.FileExists(FileName) Then
Set File = FSO.GetFile(FileName)
Set TxtStr = File.OpenAsTextStream(ForReading, TristateUseDefault)
MsgBox TxtStr.ReadAll
TxtStr.Close
' Finally Deleting the File
'File.Delete (True)
End If
End Sub