Trying to use the most recent file in folder for data.
My problem is that my master excel file wont use the data from the most recent data file (xlsx) to pull the data. My code currently has the name of the current file (eg. "Network-2019.xlsm") but lets say i insert a file called "network.xlsm, which is posted in the folder later. I want main dataset to recognize this and pull in that data.
Function GetMostRecentExcelFile(ByVal myDirectory As String, ByVal filePattern As String) As String
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim myFolder As Object
Set myFolder = fso.getfolder(IIf(Right(myDirectory, 1) = "\", myDirectory, myDirectory & "\"))
Dim currentDate As Date
Dim fname As String
Dim currentFile As Object
For Each currentFile In myFolder.Files
If (currentDate = CDate(0) Or currentFile.DateCreated > currentDate) And currentFile.name Like filePattern _
And InStr(LCase$(currentFile.name), ".xlsx") > 0 And InStr(currentFile.name, "~$") = 0 Then
currentDate = currentFile.DateCreated
fname = currentFile.name
End If
Next currentFile
GetMostRecentExcelFile = fname
End Function
I would suggest something like below, since you are using the FileSystemObject
Note that I used early binding. The associated intellisense is quite useful, and you can always change to late binding if you need to for any reason.
Option Explicit
Function GetMostRecentExcelFile(sFolderPath As String) As String
Dim FSO As FileSystemObject
Dim FO As Folder, FI As File, recentFI As File
Set FSO = New FileSystemObject
Set FO = FSO.GetFolder(sFolderPath)
For Each FI In FO.Files
Select Case FI.Name Like "*.xlsx"
Case True
Select Case recentFI Is Nothing
Case True
Set recentFI = FI
Case False
If FI.DateCreated > recentFI.DateCreated Then
Set recentFI = FI
End If
End Select
End Select
Next FI
GetMostRecentExcelFile = recentFI.Path
End Function
Related
I'm trying to name a text file created by my code.
the text file is a formated version of another text file.
Let's say i have file A: original file, and file B: formated file.
file B is created by my VBa code and i want to name file B : formate + "file A"
here's my code:
Dim order As Object
Dim Folder As Object
Dim Folder_path As String
Dim lastrow As Long
Dim fSo As Object
Dim myFile As Object
MsgBox InStrRev(Sheets(8).Cells(6, 12).Value, "\")
FolderName = "Formated Files"
Filename = "formated " & Right(Sheets(8).Cells(6, 12).Value, InStrRev(Sheets(8).Cells(6, 12).Value, "\")
[...]
Folder_path = FL + "\" + FolderName
Set fSo = CreateObject("Scripting.FileSystemObject")
If Not fSo.FolderExists(Folder_path) Then
fSo.CreateFolder (Folder_path)
If fSo.FolderExists(Folder_path) Then
Set fSo = CreateObject("Scripting.FileSystemObject")
Set myFile = fSo.CreateTextFile(Folder_path + "\" + Filename, True)
myFile.WriteLine "Error"
myFile.Close
Set fSo = Nothing
End If
Else
If fSo.FolderExists(Folder_path) Then
Set fSo = CreateObject("Scripting.FileSystemObject")
Set myFile = fSo.CreateTextFile(Folder_path + "\" + Filename, True)
for now i'm trying to get the name of the file B by using the path of the file A (so i need to get the last part of the path witch is the name of file A) and adding "formated" to it.
If you see a better way to get that name or if you find a way to simplify my code feel free to help.
If your filename looks something like this:
C:/documents/docs/filename.txt
And you want to append a word before the .txt:
C:/documents/docs/filename_suffix.txt
the easiest way is probably:
newfilename = Replace(filename,".txt","_suffix.txt",,,1)
However, if you wanted to append a word before the start of the file's name:
C:/documents/docs/prefix_filename.txt
then you could use FSO's GetBaseName in a replace
filebase=fso.getbasename(filename) & "."
newfilename = Replace(filename,filebase,"prefix_" & filebase,,,1)
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 need to traverse a zip files using VBA. In particular I need to, without unzipping the file, locate the xl folder in order to find the media subfolder. I then need to copy the images out of the media subfolder and save them to another folder.
Public Sub Extract_Images()
Dim fso As FileSystemObject
Dim objFile As File
Dim myFolder
Const zipDir As String = "\\...\ZIP FILES"
Const xlFolder As String = "xl"
Const mediaFolder As String = "media"
Dim picname As String
Dim zipname As String
Set fso = New FileSystemObject
Set myFolder = fso.GetFolder(zipDir)
For Each objFile In myFolder.Files
zipname = objFile.Name
Next objFile
End Sub
^That code successfully loops through the folder and gathers the names of the zip files. But I need to get into the files and traverse the structures to get to the Media folder.
Building off: https://www.rondebruin.nl/win/s7/win002.htm
Edit: - this shows how you can incorporate the extraction into your code. Just pass the full zip path and the location to where you want to extract the files. You can do this from within your existing loop.
You may need to account for media files sharing the same name if you're planning on extracting them all to the same location...
Sub Tester()
ExtractMediaFiles "C:\Users\twilliams\Desktop\tempo.zip", _
"C:\Users\twilliams\Desktop\extracted\"
End Sub
Sub ExtractMediaFiles(zipFile As Variant, outFolder As Variant)
Dim oApp As Object
Dim fileNameInZip As Variant, oNS As Object
Set oApp = CreateObject("Shell.Application")
On Error Resume Next
Set oNS = oApp.Namespace(zipFile & "\xl\media")
On Error GoTo 0
If Not oNS Is Nothing Then
For Each fileNameInZip In oNS.items
Debug.Print fileNameInZip
oApp.Namespace(outFolder).copyhere oNS.items.Item(CStr(fileNameInZip))
Next
Else
Debug.Print "No xl\media path for " & zipFile
End If
End Sub
I am working with some excel files. The idea is to take only those that have been modified. But here I got the problem. When I am executing the all package, the Excel connector is modifying the the "date modified" with the system hour. These files have not the property "Read Only", and I can not do nothing regarding this because I just read the files from a specific folder.
What would be the best approach to face this issue?.
This way you can Read the modified date of a file without open it, all from excel.
Sub test()
Dim FD As FileDialog
Dim i
Set FD = Application.FileDialog(msoFileDialogFilePicker)
With FD
If .Show = -1 Then
For Each i In .SelectedItems
MsgBox FileLastModified(i)
Next i
End If
End With
End Sub
Function FileLastModified(ByVal strFullFileName As String)
Dim fs As Object
Dim f As Object
Dim s As String
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(strFullFileName)
s = UCase(strFullFileName) & vbCrLf
s = s & "Last Modified: " & f.DateLastModified
FileLastModified = s
Set fs = Nothing: Set f = Nothing
End Function
My code asks the user to input a file name. We'll say we have 5 text files in directory "C:\Users\aUser\Desktop\myFolder". These text files are named A, B, C, D, and E.
If the text file exists, then I would like to write over the contents with a script I've already made. If the text file does not exist, I would like to make one with the file name they inputted, and populate it [with the script I've already written].
Thanks for your help.
The way you explain it, it seems that the easiest workflow would be:
1) Delete the file if exists
Sub test()
Dim FSO As FileSystemObject
Dim sPath As String
sPath = "U:\Test.txt"
Set FSO = New FileSystemObject
If FSO.FileExists(sPath) Then
FSO.DeleteFile (sPath)
End If
End Sub
Copy the script (I assume also a txt file) into the path:
FileCopy "U:\Script", sPath
If you have the script in a string variable:
Set txtFile = FSO.CreateTextFile(sPath, True)
txtFile.WriteLine(sText)
FSO.Close
End Sub
If the script is contained in an array, you can loop through the array and produce multiple writelines.
Don't forget to reference the Microsoft Scripting Runtime library.
Something like this
locates the folder for the logged on user regardless of OS
checks that the user input file is contained in a master list (held by StrFiles)
then either creates a new file if it doesn't exist, or
provides a logic branch for you to add your overrwrite script
Sub
code
GetFiles()
Dim wsShell As Object
Dim objFSO As Object
Dim objFil As Object
Dim strFolder As String
Dim StrFile As String
Dim StrFiles()
StrFiles = Array("A.txt", "B.txt", "C.txt")
Set wsShell = CreateObject("wscript.shell")
strFolder = wsShell.specialFolders("Desktop") & "\myFolder"
StrFile = Application.InputBox("Please enter A.txt, B.txt", "File Selection", , , , , 2)
If IsError(Application.Match(StrFile, StrFiles, 0)) Then
MsgBox StrFile & " is invalid", vbCritical
Exit Sub
End If
If Len(Dir(strFolder & "\" & StrFile)) = 0 Then
'make file
Set objFSO = CreateObject("scripting.filesystemobject")
Set objFil = objFSO.createtextfile(strFolder & "\" & StrFile, 2)
objFil.Close
Else
'write over file
'add your code here
End If
End Sub