I have a VBA Code listed below that lists all the folder names in a parent folder. I am trying to additionally list the folder properties in particular, 'Date Last Modified'. I know this is possible for files in a folder, but in this case, its the folders that I need this for.
I tried using FileSystemObject but I'm having problems with it not sure if my original code is the issue.
Can someone help me with direction as to what I can do next.
Here is my original code:
Sub GetFolders()
Dim path As String
Dim folder As String
Dim row As Integer
path = "\\C:bla bla\"
folder = Dir(path, vbDirectory)
row = 1
Do While folder <> ""
If (GetAttr(path & folder) And vbDirectory) = vbDirectory Then
Cells(row, 1) = path & folder
row = row + 1
End If
folder = Dir()
Loop
End Sub
FileDateTime() can do this.
Inside the loop:
Cells(row, 1) = path & folder
If (folder <> "." And folder <> "..") Then
Cells(row, 2) = FileDateTime(path & folder)
End If
row = row + 1
Related
I am trying to clean up some existing code
Sheets("Control").Select
MyDir = Cells(2, 1)
CopySheet = Cells(6, 2)
MyFileName = Dir(MyDir & "wp*.xls")
' when the loop breaks, we know that any subsequent call to Dir implies
' that the file need to be added to the list
While MyFileName <> LastFileName
MyFileName = Dir
Wend
MyFileName = Dir
While MyFileName <> ""
Cells(LastRow + 1, 1) = MyFileName
LastRow = LastRow + 1
MyFileName = Dir
Wend
My question relates to how Dir returns results and if there are any guarantees on the order of results. When using Dir in a loop as above, the code implies that the resultant calls to Dir are ordered by name.
Unless Dir guarantees this, it's a bug which needs to be fixed. The question, does Dir() make any guarantee on the order in which files are returned or is it implicit?
Solution
Based on #Frederic's answer, this is the solution I came up with.
Using this quicksort algorithm in conjunction and a function that returns all files in a folder ...
Dim allFiles As Variant
allFiles = GetFileList(MyDir & "wp*.xls")
If IsArray(allFiles) Then
Call QuickSort(allFiles, LBound(allFiles), UBound(allFiles))
End If
Dim x As Integer
Dim lstFile As String
x = 1
' still need to loop through results to get lastFile
While lstFile <> LastFileName
lstFile = allFiles(x)
x = x + 1
Wend
For i = x To UBound(allFiles)
MyFileName = allFiles(i)
Cells(LastRow + 1, 1) = MyFileName
LastRow = LastRow + 1
Next i
There's no guarantee that Dir() will return the files in any particular order. The MS Access VBA documentation even says:
Tip Because file names are
retrieved in no particular order, you
may want to store returned file names
in an array, and then
sort the array.
I know this post is old but I share the solution I have found for those who are also looking for a short solution.
I write all the filenames in a Excel sheet column and I use a variable which will get the name of the files. Then I run a loop to open each file based on the name retrieved by the variable according to the order they have written in the column.
For Row_Value = 1 To 10
NameFile= Range("N" & Row_Value).Value 'NameFile = "Worbook1"
MyFile = Dir("C\Desktop\Folder1\" & NameFile & ".xlsm")
Next Row_Value
I hope it's clear.
OK, so I have code that will take the data entered in "A3" and open a widows search with "*" + A3's contents. What I need now is when any file is found with that search to find the folder name that houses it. Basically we have prints stored by a random number not associated to the real part number but all the related prints are stored within this random numbered folder.
Example:
C:\Document Control\Master Prints*12345*\printxyz.pdf
If I were to search for "*xyz" and "printxyz.pdf" shows up, I now need the "12345" folder name to populate in a cell.
Here is what im using so far
Sub Macro4()
Dim var As Variant
var = "*" & Range("A3").Value
Call Shell("explorer.exe " & Chr(34) & "search-ms:query=" & var & "&crumb=location:""C:\Document Control\Master Prints" & Chr(34), vbNormalFocus)
End Sub
I did something similar recently. I had words in cell E1 that pertains to files in a folder. So I did an instr on the first 5 letters of that cell as my search then looped through the folder to find the file containing that string.
You should be able to adapt this code to what you need.
Const parentFolder As String = "I:\this\that\"
subFolder = parentFolder & getFoldPath(parentFolder, Left(.Range("E1"), 5)) & "\"
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(subFolder)
For Each oFile In oFolder.Files
If InStr(oFile, Left(.Range("E1"), 5)) > 0 Then
scope = subFolder & oFile.name
End If
Next
I am quite new to VBA as I have been using other programming languages.
I am trying to use a combo box to list the latest 2 folders from my path.
I have already been able to select all data from the required path as well as I have sorted this.
I need support to be able to list only the latest 2 folders based on my code but am struggling and require help.
Drivepath = Mid(ThisWorkbook.Path, 1, 2)
On Error Resume Next
filepath = Drivepath & "C:\Users\Documents\Month\" & ThisWorkbook.Sheets("Months"). ComboBox1.Value & "\"
Application.Workbooks.Open (filepath & s_workbook)
Application.Sheets(1).Activate
Dim name
ThisWorkbook.Sheets("Months"). ComboBox1.Clear
Drivepath = Mid(ThisWorkbook.Path, 1,2)
For Each name In ListDirectory(Path:=Drivepath & "C:\Users\Documents\Monthâ, AttrInclude:=vbDirectory, AttrExclude:=vbSystem Or vbHidden)
If Len(name) > 4 Then
If InStr(name, "list") = 0 Then ThisWorkbook.Sheets("Months"). ComboBox1.AddItem name
End If
Next name
'Sort the list
ComBoList = ThisWorkbook.Sheets("Months"). ComboBox1.List
For X = LBound(ComBoList) To UBound(ComBoList) - 1
For j = X + 1 To UBound(ComBoList)
If ComBoList(X, 0) > ComBoList(j, 0) Then
ComBoTemp = ComBoList(X, 0)
ComBoList(X, 0) = ComBoList(j, 0)
ComBoList(j, 0) = ComBoTemp
End If
Next j
Next X
hold_name = ComBoList(UBound(ComBoList), 0)
ThisWorkbook.Sheets("Months"). ComboBox1.List = ComBoList
ThisWorkbook.Sheets("Months"). ComboBox1.Value = hold_name
ListDirectory
ListDirectory function
Function ListDirectory(Path As String, AttrInclude As VbFileAttribute, Optional AttrExclude As VbFileAttribute = False) As Collection
Dim Filename As String
Dim Attribs As VbFileAttribute
Set ListDirectory = New Collection
' first call to Dir() initializes the list
Filename = Dir(Path, AttrInclude)
While Filename <> ""
Attribs = GetAttr(Path & Filename)
' to be added, a file must have the right set of attributes
If Attribs And AttrInclude And Not (Attribs And AttrExclude) Then
If Len(Filename) > 4 And InStr(Filename, "Oracle") = 0 Then
ListDirectory.Add Filename, Path & Filename
End If
' fetch next filename
Filename = Dir
Wend
End Function
Am using sorting to sort the folders as all the required folders are named the following. E.g, 201901, 201902, 201903, 201904, 201905 and etc.
I just need a solution for selecting the last 2 folders which are 202003 & 202004.
I could easily delete all the other folders from the path but am looking for a more efficient way to only display 2 of the latest folders in the combo box.
Again, I have already sorted them but once I sorted them I would like to display or select only the latest folders based on sorting them.
K = UBound(ComboList)
TwoNewest = ComboList(K) & vbcrlf & ComboList(K-1)
ComboBox1.List = split(TwoNewest,vbcrlf)
There my be better ways but that'll work
I want to create folders with Excel, in a way that every time a make a new entry in the selected column, a new folder is created.
I already searched and found some codes to VBA that creates the folders. But I have to select the cells and then run the macro everytime. Is there any way that I can do that automatically?
Thank you in advance,
Leo
Below is the code for creating new folders (Sub directories)
Sub CreateFolder()
Dim caminho As String
Dim folder As Object, FolderName
For i = 1 To 500
Set folder = CreateObject("Scripting.FileSystemObject") FolderName = ActiveWorkbook.Path & "\" & Range("A" & i).Value
If Not folder.FolderExists(FolderName) Then
folder.CreateFolder (FolderName)
End If
directory = ThisWorkbook.Path
Next i
End Sub
Yes, we can help you. Just need some pertinent info. Does the column need to be selected? Or can you work with a hard coded column? Say a column like Column D... We can put a Worksheet_Change macro on your worksheet module so that whenever a value in a certain column is changed - it will automatically check to see if that folder exists and if not then create it.
Here is an example that will create folders for any new or changed cells in column D:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim caminho As String
Dim folder As Object, FolderName
If Target.Column = 1 And Target.Value <> "" Then ' If Changed Cell is in Column A
' This code changes unacceptable file name characters with an underscore
Filename = Target.Value
MyArray = Array("<", ">", "|", "/", "*", "\", "?", """")
For X = LBound(MyArray) To UBound(MyArray)
Filename = Replace(Filename, MyArray(X), "_", 1)
Next X
' This code creates the folder if it doesn't already exist
Set folder = CreateObject("Scripting.FileSystemObject")
FolderName = ActiveWorkbook.Path & "\" & Filename
If Not folder.FolderExists(FolderName) Then
folder.CreateFolder (FolderName)
End If
End If
End Sub
this is my first time posting, sorry for any mistakes.
I'm trying to do a loop through server file folder (UNC Path) to find a specific child folder (project folder) to save the workbook (user will inform the project related to the folder).
I'm using a loop and DIR() function but for some reason DIR() returns "." for the first folder loop and for the second loop returns the first child folder.
StdPath = "\\Server\Database$\ABC\"
'Find project folder
Dirloop1 = Dir(StdPath, vbDirectory) 'Should return the 1st child folder, instead returns "."
'Loop into folders until find the project folder speficied by the user
Do Until Dirloop1 = ""
If (GetAttr(StdPath & Dirloop1) And vbDirectory) = vbDirectory Then
Dirloop2 = Dir(StdPath & Dirloop1, vbDirectory) 'This should indicate the 2nd child folder but instead is returning the 1st child folder
Do Until Dirloop2 = ""
If (GetAttr(StdPath & Dirloop1 & Dirloop2) And vbDirectory) = vbDirectory Then 'Error happens here since it didn't reach the second child folder
If InStr(Dirloop2, ActiveSheet.Range("N7")) > 0 Then
StdPath = StdPath & Dirloop1 & Dirloop2
MsgBox StdPath
Exit Do
Else
Dirloop2 = Dir()
End If
End If
Loop
If InStr(StdPath, ActiveSheet.Range("N7")) = 0 Then
Exit Do
End If
End If
Dirloop1 = Dir()
Loop
This is my first time using programming therefore doesn't have much experience if there's anyone who could give me a better solution I appreciate the support.
Rory and Comintern, thanks for the support, I finally managed to do it using FileSystemObject, much more easier than DIR() statement actually. I had to read about it first in order to implement it but the result was ok, code is below.
Public FSO As New FileSystemObject
Sub ProjectFolder()
Dim Dirloop as Folder
Dim Dirloop2 as Folder
StdPath = "\\Server\Database$\ABC\"
Set Dirloop = FSO.GetFolder(StdPath)
'Find Project Folder
For Each subfolder In Dirloop.SubFolders
Set Dirloop2 = FSO.GetFolder(subfolder.Path)
For Each subfolder2 In Dirloop2.SubFolders
If InStr(subfolder2.Path, ActiveSheet.Range("N7")) > 0 Then
ProjectPath = subfolder2.Path
End If
Next
Next
If Len(ProjectPath) = 0 Then
MsgBox "Folder not found. Please talk with Project Leader"
Exit Sub
End If
' Rest of the code below
Once again thanks for the help.