I'm trying to rename all the sub-folders in a specific folder (C:Users\admin\Documents\AWS). In Column A I have the old folder names, to be changed to the corresponding new names in B.
This is the code I tried (typed in Sheet17 in Visual Basic Editor). Sheet17 is the spreadsheet in the workbook with the two columns of text. All the sub-folders are in the AWS folder.
Sub rename_folder()
Const FILEPATH As String = "C:Users\admin\Documents\AWS\"
Dim strfile As String
Dim filenum As String
strfile = Dir(FILEPATH)
Dim old_name, new_name As String
For i = 2 To Sheets(17).Range("a1").End(xlDown).Row
strOldDirName = FILEPATH & Sheets(17).Cells(i, 1).Value
strNewDirName = FILEPATH & Sheets(17).Cells(i, 2).Value
Name strOldDirName As strNewDirName
Next i
MsgBox "Congratulations! You have successfully renamed all the Folders"
End Sub
I got
Run-time error '53': File not found
when running the code. Couldn't find the Debug Window (I'm on Mac, using Microsoft 2017), but it's probably one of the first few lines of code. Please let me know if any of the subsequent lines should be changed as well.
This worked fine for me.
Sub rename_folder()
Const FILEPATH As String = "C:\Users\Excel\Desktop\test\"
Dim strfile As String
Dim filenum As String
strfile = Dir(FILEPATH)
Dim old_name, new_name As String
For i = 2 To Sheets(1).Range("a2").End(xlDown).Row
strOldDirName = FILEPATH & Sheets(1).Cells(i, 1).Value
strNewDirName = FILEPATH & Sheets(1).Cells(i, 2).Value
Name strOldDirName As strNewDirName
Next i
MsgBox "Congratulations! You have successfully renamed all the Folders"
End Sub
Before:
After:
Could be
Const FILEPATH As String = "C:\Users\admin\Documents\AWS\"
instead of
Const FILEPATH As String = "C:Users\admin\Documents\AWS\"
cause of the missing \ after drive letter
Related
Using 2010 Excel VBA - I need to use look up the image/pdf with the Branch Code as a part of its name at "C:\ECB Test\ECB IR COPY" and paste it at "C:\ECB Test\" RO if it exists. If it doesn't, the program needs to highlight the Branch Code.
(File Name Examples: 28-Kochi-ecb-sdwan completed.pdf, 23 eCB Kozhikode completed.pdf/0036.jpeg)
Having done this manually twice for two other excel sheets (4k+ cells), I decided to Frankenstein a module together and, well, it does not work and I have no idea why.
Sub Sort()
Const SRC_PATH As String = "C:\ECB Test\ECB IR COPY"
Const DEST_PATH As String = "C:\ECB Test"
Dim Row_Number As Integer
Dim fso As Object
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
Dim Folder_Name As String
Dim Branch_Code As String
Dim Final_Path As Variant
Dim File As String
For Row_Number = 3 To 2465
Branch_Code = Worksheets("WAN RFP").Cells(Row_Number, 2)
Folder_Name = Worksheets("WAN RFP").Cells(Row_Number, 5)
On Error Resume Next
File = Dir(SRC_PATH & "\*" & Branch_Code & "*")
Final_Path = Dir(DEST_PATH & "\" & Folder_Name & "\")
If (Len(File) > 0) Then
Call fso.CopyFile(File, Final_Path)
Else
Cells(Row_Number, 2).Interior.ColorIndex = 6
End If
On Error GoTo 0
DoEvents
Next Row_Number
End Sub
I think its unable to use the Branch Code variable as a wildcard, though I might as well have done something silly somewhere in the code. Can someone please help me out?
The problem is you are using the destination path instead of the source path:
File = Dir(DEST_PATH & "*" & Branch_Code & "*.*")
Change it to
File = Dir(SRC_PATH & "*" & Branch_Code & "*.*")
I have found this VBA code and it works to remove the known password on one Excel workbook just fine.
Sub testPasswordRemoval()
Dim wb As Workbook
Set wb = Workbooks.Open(Filename:="C:\Temp\Book2.xlsm", Password:="pw")
wb.Password = ""
wb.SaveAs "C:\Temp\NewBook.xlsm"
End Sub
But, I have tried various tutorials and videos (many folks offering this) but none of them work to loop through a folder of .xlsx files (all with the same known password) and remove that same password.
I am not a VBA person, but have spent about 16 hours over the past three days trying to crack the code on this one. I have found several examples of looping over files in a directory, but none that enabled me to put the above code into them and loop and remove passwords.
Try this code, read the comments, and adjust it to fit your needs
Code:
Public Sub RemovePassLoopThroughFiles()
Dim targetWorkbook As Workbook
Dim filePath As String
Dim folderPath As String
Dim folderWildcard As String
Dim currentFileName As String
Dim currentFileExtension As String
Dim newFileName As String
Dim newfileNameSuffix As String
Dim currentPassword As String
Dim newPassword As String
' Adjust next lines to fit your needs
folderPath = "C:\Temp\" ' With slash at the end
folderWildcard = "*.xls*" ' You can change the suffix to open specific files
newfileNameSuffix = "_NoPassword"
currentPassword = "pw"
newPassword = ""
' Get the file path concat folder and wildcards
filePath = Dir(folderPath & folderWildcard)
Do While Len(filePath) > 0
' Open the workbook and set reference
Set targetWorkbook = Workbooks.Open(Filename:=filePath, Password:=currentPassword)
' Get current file extension
currentFileExtension = Right(filePath, Len(filePath) - InStrRev(filePath, "."))
' Get filename no extension
currentFileName = Left(filePath, InStrRev(filePath, ".") - 1)
' Build new fileName
newFileName = currentFileName & newfileNameSuffix & "." & currentFileExtension
' Set new password
targetWorkbook.Password = newPassword
' Save new file
targetWorkbook.SaveAs folderPath & newFileName
'Debug.Print filePath
filePath = Dir
targetWorkbook.Close True
Set targetWorkbook = Nothing
Loop
End Sub
Let me know if it works.
I want to improve my Excel VBA macro that creates the file list and the macro that renames the file name on the file list.
I made two Excel VBA macros. The macro named "Sub File_list" creates a file list in a folder where the xls file is stored and, The macro named "Sub Re_name" renames files using the file list. However, these macros cannot handle files in subfolders.These macros are show below, you can download the macro from this link.
【My Questions】
I want the "Sub File_list" to have the ability to list files in subfolders.
I want these "Sub Re_name" to have the ability to rename files in subfolders.（The renamed file shall stored in the same file as the original file.)
Assume that the files and folders shown in FIG. 1 are stored in the folders.
The "File_mng.xls" is the excel file that consists these macros.
Fig.1
At this time, when the "Sub File_list" is executed, all files stored in the same level (except "File_mng.xls" itself) are displayed on the spreadsheet (See Fig.2). However, sub folders and the files stored in that sub folders are not listed.
Fig.2
Note that, the backslash is garbled into the Yen sign because My Windows10 is Japanese version.
【The macros】
You can also download the macro from this link.
'Create a list of files in a specific folder
Sub File_list()
Dim myFileName As String
Dim FSO As Object
Dim cnt
myDir = ThisWorkbook.Path
myDir = myDir & "\"
Set FSO = CreateObject("Scripting.FileSystemObject")
cnt = FSO.GetFolder(myDir).Files.Count
Range("A1").Value = "File name (Number of files " & cnt & ")"
'Show hidden and system files
myFileName = Dir(myDir & "*", vbHidden + vbSystem)
While myFileName <> vbNullString
If myFileName <> ThisWorkbook.Name Then
Cells(Rows.Count, 1).End(xlUp).Offset(1).Value _
= myDir
Cells(Rows.Count, 2).End(xlUp).Offset(1).Value _
= myFileName
End If
myFileName = Dir()
Wend
Columns(1).AutoFit
Application.ScreenUpdating = True
End Sub
'Renames files using the file list
Sub Re_name()
myDir = ThisWorkbook.Path
Nmax = (ActiveSheet.Range("A1").End(xlDown).Row)
For n = 2 To Nmax
yenn = ""
If (Right(Cells(n, 1), 1) <> "\") Then
yenn = "\"
End If
N1 = Cells(n, 1) & yenn & Cells(n, 2)
N2 = Cells(n, 3) & Cells(n, 4) & Cells(n, 5) & Cells(n, 6)
If N2 = "" Then
N2 = N1
Else
N2 = myDir & "\" & N2
End If
Name N1 As N2
Next n
End Sub
P.S. I'm not very good at English, so I'm sorry if I have some impolite or unclear expressions. I welcome any corrections and English review. (You can edit my question and description to improve them)
You can download all related files from here.
Post hoc Note: (Added on 2019/12/15(JST))
【Comment on the trust settings for PASUMPON V N's macro 】
Thanks to the contributions of PASUMPON V N, I get a complete solution.
You can download a modified version so that it lists files based on the folder where the macro is.
(I modified HostFolder = "C:\User\" to HostFolder = ThisWorkbook.Path )
Running this macro, I came across one error, 'Error 1004: Programmatic access to Visual Basic Project is not trusted' at the line of ".VBProject.References". But It is solved by security settings of excel.
The setting method may depend on version and language
For the Japanese version, if you come across the following error, this site(but written in Japanese) might be helpful. What I actually tried was the procedure written in this site.
"プログラミングによる visual basic プロジェクトへのアクセスは信頼性に欠けます 1004"(that means "'Error 1004: Programmatic access to Visual Basic Project is not trusted")
For the English version,here or here might be helpful if you come across the Error 1004.
Hi I have modified the code for your requirement, could you please let me know if it is fine
i have used below code , for recursive type programming
Loop Through All Subfolders Using VBA
Sub sample()
Dim FileSystem As Object
Dim HostFolder As String
Dim Ref As Object, CheckRefEnabled%
CheckRefEnabled = 0
With ThisWorkbook
For Each Ref In .VBProject.References
If Ref.Name = "Scripting" Then
CheckRefEnabled = 1
Exit For
End If
Next Ref
If CheckRefEnabled = 0 Then
.VBProject.References.AddFromGUID "{420B2830-E718-11CF-893D-00A0C9054228}", 1, 0
End If
End With
HostFolder = "C:\User\"
Set FileSystem = CreateObject("Scripting.FileSystemObject")
DoFolder FileSystem.GetFolder(HostFolder)
End Sub
Sub DoFolder(Folder)
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet1")
Dim LastRow As Long
Dim SubFolder
For Each SubFolder In Folder.SubFolders
DoFolder SubFolder
Next
Dim File
For Each myFile In Folder.Files
Debug.Print myFile
Debug.Print Folder.Name
Debug.Print myFile.Name
With ws
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
i = LastRow + 1
ws.Cells(i, 1) = myFile.Path
ws.Cells(i, 2) = Folder.Name
ws.Cells(i, 3) = myFile.Name
Next
End Sub
I want to write a code that will open the file path and within this folder the user can select his own folder. I only seem able to find a "general" code to open a folder.
With wbtarget.Sheets("Data")
strPathName = Application.GetOpenFilename()
If strPathName = "False" Then
Exit Sub
End If
Set wbsource = Workbooks.Open(strPathName, 0)
.Range("A1:AL10000").Value = wbsource.Sheets(1).Range("A1:AL10000").Value
wbsource.Close (False)
End With
or open a specific file.
folder_path = CStr("C:\Users\peter\Documents\me")
file_name = CStr("report.xlsm")
StrResource = folder_path & "\" & file_name
thank you for your help.
I use this function to let the user browse for a folder instead of a file. I don't remember where I found it.
It uses the Shell.BrowseForFolder method.
Set InitPath to a string <> "", e.g. "D:\Files", to limit the folder tree the user can choose from.
Public Function GetFolderName(Caption As String, InitPath As String) As String
Dim AppShell As Object
Dim BrowseDir As Variant
Dim sPath As String
Set AppShell = CreateObject("Shell.Application")
If InitPath <> "" Then
Set BrowseDir = AppShell.BrowseForFolder(0, Caption, &H11, (InitPath))
Else
' 17 = root folder is "My Computer"
Set BrowseDir = AppShell.BrowseForFolder(0, Caption, &H11, 17)
End If
sPath = ""
On Error Resume Next
sPath = BrowseDir.Items().Item().Path
GetFolderName = sPath
End Function
I'm trying to save excel file into a specific path.
So basically, when I click the button, I'm creating a folder, and want to save the file inside that folder.
The created folder has the current month as name. I'm trying to save into that current month folder.
'Create folder as Month Name. Save filename as date inside "month".
Dim sDate As String = DateTime.Now.ToString("yyyy-MM-dd") & "_" & DateTime.Now.ToString("HH-mm-ss")
Dim sMonth As String = DateTime.Now.ToString("MMMM")
Dim sFolder = Application.StartupPath & "\Resources\Excel\"
My.Computer.FileSystem.CreateDirectory(sFolder & Format(sMonth))
Dim sfinal = Path.Combine(sFolder, sMonth)
xlSh.SaveAs(sfinal & Format(sDate) & ".xlsx")
xlApp.Workbooks.Close()
xlApp.Quit()
As it is, this code doesn't give me any errors. But instead of creating a folder named "March" <-current month and saving inside it, it saves the file in \Excel\ and it also creates folder in the same place.
you could use the following function (similar to .NET System.IO.Path.Combine)
Function PathCombine(path1 As String, path2 As String)
Dim combined As String
combined = path1
If Right$(path1, 1) <> Application.PathSeparator Then
combined = combined & Application.PathSeparator
End If
combined = combined & path2
PathCombine = combined
End Function
Hope this helps!
After long hours of excruciating pain, I've finally did it!
Apparently I was missing an "\"
Since "sMonth" became dynamic name, which later I wanted to use as path, and save files in that folder. I needed to simply put that "\" after sMonth, to tell it to save inside it.
Before I realize this... I've broken down, simplified the code as much as I could so I can logically connect the pieces. What I ended up with, is something slightly different. Now the SaveAS properly saves the file inside the new folder.
Dim sDate As String
sDate = DateTime.Now.ToString("yyyy-MM-dd") & "_" & DateTime.Now.ToString("HH-mm-ss")
Dim sMonth As String
sMonth = DateTime.Now.ToString("MMMM")
Dim sFileName As String
sFileName = sDate + ".xlsx"
Dim sFolder As String
sFolder = Application.StartupPath & "\Resources\Excel\"
Dim sfinal As String
sfinal = (sFolder & sMonth & "\") '<- this thingie here o.O
My.Computer.FileSystem.CreateDirectory(sFolder & Format(sMonth))
xlSh.SaveAs(sfinal & Format(sFileName))
xlApp.Workbooks.Close()
xlApp.Quit()
Thanks for the help.
You don't appear to actually be setting the save path to the created directory. Instead, I believe you're appending the month to the beginning of the file name in the xlSh.SaveAs(sFinal & Format(sDate) & ".xlsx"). Basically (though I'm not sure of the specific command) you need to navigate to the folder you created after you create it. Probably something to the format of
My.Computer.FileSystem.ChangeDirectory(sFolder & Format(sMonth))
though I don't know that that specific command actually exists as I wrote it.
To those who have been wondering wtf I was doing with all this, here is the full sub. And if anyone needs something similar. Thanks for the support. Problem has been resolved.
Private Sub Button_Click(sender As Object, e As EventArgs) Handles Button.Click
Dim xlApp As Excel.Application
Dim xlSh As Excel.Worksheet
xlApp = New Excel.Application
xlApp.Workbooks.Add()
xlSh = xlApp.Workbooks(1).Worksheets(1)
'Items from listbox1 to be exported into excel, second row, second column.
Dim row As Integer = 2
Dim col As Integer = 2
For i As Integer = 0 To ListBox1.Items.Count - 1
xlSh.Cells(row, col) = ListBox1.Items(i)
row = row + 1
Next
row += 1
col = 1
'Items from listbox2 to be exported into excel, second row, third column.
Dim row2 As Integer = 2
Dim col2 As Integer = 3
For i As Integer = 0 To ListBox2.Items.Count - 1
xlSh.Cells(row2, col2) = ListBox2.Items(i)
row2 = row2 + 1
Next
row2 += 1
col2 = 1
'Create folder as Month Name. Save filename as date inside that folder.
'Make filename be yyyy-MM-DD_HH-mm-ss
Dim sDate As String
sDate = DateTime.Now.ToString("yyyy-MM-dd") & "_" & DateTime.Now.ToString("HH-mm-ss")
'This will be used as name for the new folder.
Dim sMonth As String
sMonth = DateTime.Now.ToString("MMMM")
'Filename + extension.
Dim sFileName As String
sFileName = sDate + ".xlsx"
'This is the path.
Dim sFolder As String
sFolder = Application.StartupPath & "\Resources\Excel\"
'This is the path combined with sMonth to make the final path.
Dim sfinal As String
sfinal = (sFolder & sMonth & "\")
'Check if folder with the name sMonth already exists.
If Dir(sFolder, vbDirectory) = sMonth Then
'If it exist, then simply save the file inside the folder.
xlSh.SaveAs(sfinal & Format(sFileName))
Else
'If it doesn't exist:
'This is the creation of sMonth folder, inside "\excel\.
My.Computer.FileSystem.CreateDirectory(sFolder & Format(sMonth))
'This saves the excel file at path sfinal, with filename of sFileName
xlSh.SaveAs(sfinal & Format(sFileName))
End If
'Close everything.
xlApp.Workbooks.Close()
xlApp.Quit()
End Sub
I find this method to be much easier.
Create a FileSystemObject and use BuildPath Method, like so:
Set fs = CreateObject("Scripting.FileSystemObject")
skPath = fs.BuildPath(ActiveDocument.Path, "Survival Story of Sword King")
Attention: ActiveDocument.Path is current directory in Word and does not work in excel or other. for excel it would be ActiveWorkbook.Path
My point is some methods or namespace are application specific.