Suppose, we have one folder with only one macro file and every day we are saving excel file in the same folder received via mail. However, filename every day will get changed. I mean to say what ever file we are getting through mail do not have a standard name. Now, we have two files in the same folder.
Can we open another file which we have saved with some random name available in the same folder using a macro? Here, the name of another file is not standard. Additionally, after running a macro, we also want to delete that file.
You can get the filename of the newest file within a directory by this:
Option Explicit
Private Sub GetNewestFilename()
Dim searchDirectory As String
Dim searchPattern As String
Dim currentFilename As String
Dim NewestFilename As String
Dim NewestFiledate As Date
searchDirectory = Application.DefaultFilePath & "\"
searchPattern = "*.xl*"
currentFilename = Dir(searchDirectory & searchPattern, 0)
If currentFilename <> "" Then
NewestFilename = currentFilename
NewestFiledate = FileDateTime(searchDirectory & currentFilename)
Do While currentFilename <> ""
If FileDateTime(searchDirectory & currentFilename) > NewestFiledate Then
NewestFilename = currentFilename
NewestFiledate = FileDateTime(searchDirectory & currentFilename)
End If
currentFilename = Dir
Loop
End If
MsgBox NewestFilename
Dim wb As Workbook
Set wb = Workbooks.Open(searchDirectory & NewestFilename)
' do something
wb.Close SaveChanges:=False
Set wb = Nothing
' Kill searchDirectory & NewestFilename ' Delete the file
End Sub
Related
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'm trying to write a code that will refresh all workbooks starting with 'FY' in a folder. With the current code, the first two workbooks refresh, but when it comes to the third workbook, I get this error:
Sorry, we couldn't find FY20 11-15.xlsm\FY20 1-5.xlsm. Is it possible it was moved, renamed or deleted?"
The path to the workbook is "C:\Documents\Database\Sales".
Here's the code:
Sub refreshdata()
Dim file As String
Dim book As String
file = Application.ThisWorkbook.Path
book = Dir(file & "\FY*.xlsm")
Do While file <> ""
Dim wb As Workbook
Set wb = Workbooks.Open(file & "\" & book)
Call Refresh
wb.Close savechanges:=True
file = Dir
Loop
End Sub
You named your variables not clearly and file contains actually a path file = Application.ThisWorkbook.Path therefore you mixed everything up. Get your variable names more meaningful! Make sure your variables are well named after what content they contain or you confuse yourself.
Sub refreshdata()
Dim Path As String
Path = Application.ThisWorkbook.Path
Dim FileName As String
FileName = Dir(Path & "\FY*.xlsm")
Do While FileName <> vbNullString
Dim wb As Workbook
Set wb = Workbooks.Open(Path & "\" & FileName)
Call Refresh
wb.Close SaveChanges:=True
FileName = Dir
Loop
End Sub
What was wrong?
Here file = Dir you set your file variable which actually was the path to filename. And in the next iteration of the loop Set wb = Workbooks.Open(file & "\" & book) is twice a filename, the new filename in file and the old in book.
I want to open a file (file) that is stored in a folder (Source) which is in the same directory as the current workbook. I get a runtime error 1004 indicating that it the file can't be located. What am I doing worng?
Set x = Workbooks.Open(ThisWorkbook.Path & "\Source\file*.xlsx")
Since you want the wildcard to stay, you need to loop through the files in the folder. Something like this may be of interest to you:
Sub FileOpen()
Dim sPath As String
Dim sFile As String
Dim wb As Workbook
sPath = ThisWorkbook.Path & "\Source\"
sFile = Dir(sPath & "file*.xlsx")
' Loops while there is a next file found in the specified directory
' When there is no next file the Dir() returns an empty string ""
Do While sFile <> ""
' Prints the full path of the found file
Debug.Print sPath & sFile
' Opens the currently found file
Set wb = Workbooks.Open(sPath & sFile)
' Place your code here
' Place your code here
' Place your code here
' Close the current workbook and move on to the next
wb.Close
' This line calls the Dir() function again to get the next file
sFile = Dir()
Loop
End Sub
Good luck!
Replace the wildcard with actual filename.
Set x = Workbooks.Open(ThisWorkbook.Path & "\Source\file.xlsx"
I changed the file*.xlsx to file. xlsx...hope your code works.
thanks.
In my program, i want to browse through a complex file structure, and display the newest file in it.
The file structure has several folders and subfolders, most of the time empty. So this macro would help to reveal where the latest information is.
Sub newestFile()
Dim FileSystem as object
Dim MostRecentFile as string
Dim MostRecentDate as Date
Dim FileSpec as String
Dim filename as string
'This is where i specify what type of files i would be looking for
FileSpec ="*.*"
'This is where i specify where the master directory is, so that i may look down into it
Directory ="c:\Directory1\"
filename = Dir(Directory & FileSpec)
set Filesystem = CreateObject("Scripting.FileSystemObject")
Do Folder FileSystem.getFolder(Directory)
set ws = Sheets("Events")
ws.cells(2,7).value = MostRecentFile
ws.cells(2,8).value = MostRecentDate
end sub
private Function DoFolder(Directory)
For each subfolder in Directory.SubFolders
DoFolder subfolder
Dim file
For each File in Directory.files
'actions go here
If File <> "" Then
MostRecentFile = File
MostRecentDate = FileDateTime(Directory)
If FileDateTime(File) > MostRecentDate Then
MostRecentFile = File
MostRecentDate = FileDateTime(File)
End if
End If
next
next
End Function
on this code i always loose the variables (MostRecentFile and MostRecentDate) when the code goes to another subfolder.
I expected on having the name of the newest file (of the whole structure), and the date.
As was said, scope is certainly a concern. Here's a loop within the subroutine:
Sub newestFile()
Dim FileSystem As Object ' Needed to get file properties
Set FileSystem = CreateObject("Scripting.FileSystemObject")
Dim MostRecentDate As Date
Dim MostRecentFile As String
Directory = "c:\Directory1\"
FileSpec = "*.txt" '<-- can be "*.xls*" or whatever criteria needed
MyFile = ""
'Loop through text files in Directory finding the most current file
MyFile = Dir(Directory & FileSpec) 'Get first file name in directory
Do While MyFile <> ""
If MostRecentDate < FileSystem.GetFile(Directory & MyFile).DateLastModified Then
MostRecentDate = FileSystem.GetFile(Directory & MyFile).DateLastModified
MostRecentFile = MyFile
End If
MyFile = Dir 'Get next file matching criteria
Loop
set ws = Sheets("Events")
ws.cells(2,7).value = MostRecentFile
ws.cells(2,8).value = MostRecentDate
End Sub
You need to declare the variables at module level
Private MostRecentFile as string
Private MostRecentDate as Date
Sub newestFile()
....
End Sub
I have an issue and I need your help. here is the problem. I have inside a folder some excel files that I have to open automatically in order to make some operations. Those files have the same name except the number of the files like this:
Folder name : Extraction_Files
Files name : - "System_Extraction_Supplier_1"
- "System_Extraction_Supplier_2"
- "System_Extraction_Supplier_3"
The number of files can change so i used a loop Do While to count the number of files, then the plan is to use a loop for I =1 to ( number of files) to open all of theme.
please read my code. I know that i used a wrong way to read file name using a loop for but I share it because I don't have an other idea.
Here is my code :
Sub OpenFiles ()
Dim MainPath as String
Dim CommonPath as String
Dim Count As Integer
Dim i As Integer
' the main path is " C:\Desktop\Extraction_Files\System_Extraction_Supplier_i"
'with i = 1 to Count ( file number )
CommonPath = "C:\Desktop\Extraction_Files\System_Extraction_Supplier_*"
'counting automatically the file number
Filename = Dir ( CommonPath )
Do While Filename <> ""
Count = Count + 1
Filename = Dir ()
Loop
'the issue is below because this code generate a MsgBox showing a MainPath with the index i like this
'"C:\Desktop\Extraction_Files\System_Extraction_Supplier_i"
' so vba can not find the files
For i = 1 To count
MainPath = "C:\Desktop\Extraction_Files\System_Extraction_Supplier_" & "i"
MsgBox MainPath &
Workbooks.Open MainPath
Next
End Sub
what is the best approach to this?
Why not count as you open them. You're already identifying them so why not open each file as you go:
Sub OpenFiles()
Dim Filename As String
Dim CommonPath As String
Dim Count As Integer
CommonPath = "C:\Desktop\Extraction_Files\"
Filename = Dir(CommonPath & "System_Extraction_Supplier_*")
Do While Filename <> ""
MsgBox Filename
Workbooks.Open CommonPath & Filename
Count = Count + 1
Filename = Dir()
Loop
End Sub
PS. It might be worth adding .xl* or similar to the end of your search pattern to prevent Excel trying to open files that aren't Excel files:
Filename = Dir(CommonPath & "System_Extraction_Supplier_*.xl*")
If you want to open all folders, in a specific folder, which start with "NewFile_", one loop only is needed:
Sub OpenFolders()
Dim path As String: path = ""C:\Desktop\Extraction_Files\""
Dim fileStart As String: fileStart = "System_Extraction_Supplier_"
Dim Fso As Object
Dim objFolder As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Set objFolder = Fso.GetFolder(path)
For Each objSubFolder In objFolder.subfolders
If InStr(1, objSubFolder.Name, fileStart) Then
Shell "explorer.exe " & objSubFolder, vbNormalFocus
Debug.Print objSubFolder.Name
End If
Next objSubFolder
End Sub
Folders in vba are opened with the Shell "explorer.exe " command. The code opens every folder in "C:\yourFile\", which contains NewFile_ in the name. This check is done with If InStr(1, objSubFolder.Name, fileStart) Then.