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
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.
I have a spreadsheet that users can interact with to specify the file path to 4 different files needed to be opened to run some macros. The code includes a check to see if the file path they have entered is valid or not (works excellently). However, what I want to do is have a message box appear if anything doesn't work and then also tell the user which one didn't work.
My code does do that perfectly (albeit in I think a quite convoluted way) however as the array is set to have 4 values it means if the final file isn't present, it starts the text 4 lines down in the message box instead of at the top.
What I want to do, I believe, is ReDim the array to only the amount of files missing so that the MsgBox isn't 3 empty lines below the first sentence. I've kinda figured that bit out but I just could not get it working properly and now I am stumped.
Sub Open_month_0()
On Error GoTo ErrHand
ThisWorkbook.ActiveSheet.Calculate
Dim i As String
Dim j As String
Dim k As String
Dim l As String
Dim m As String
Dim n As String
Dim o As String
Dim p As String
Dim arr(4) As Variant
Dim File_Missing As Integer
'Used as a counter to prompt either an error or successful result
File_Missing = 0
i = Range("LUX_Full_file_path")
j = Range("LUX_Full_file_name")
k = Range("JUP_Full_file_path_M")
l = Range("JUP_Full_file_name_M")
m = Range("JUP_Full_file_path_Q")
n = Range("JUP_Full_file_name_Q")
o = Range("JUP_Full_file_path_A")
p = Range("JUP_Full_file_name_A")
'The if not's check to see if the file path is valid. If it isn't, gets added to array and File_missing begins
If Not Dir(i, vbDirectory) = vbNullString Then
Workbooks.Open (i)
Windows(j).Visible = False
Else
arr(1) = "Lux file"
File_Missing = File_Missing + 1
End If
If Not Dir(k, vbDirectory) = vbNullString Then
Workbooks.Open (k)
Windows(l).Visible = False
Else
arr(2) = "Monthly file"
File_Missing = File_Missing + 1
End If
If Not Dir(m, vbDirectory) = vbNullString Then
Workbooks.Open (m)
Windows(n).Visible = False
Else
arr(3) = "Quarterly file"
File_Missing = File_Missing + 1
End If
If Not Dir(o, vbDirectory) = vbNullString Then
Workbooks.Open (o)
Windows(p).Visible = False
Else
arr(4) = "Annual file"
File_Missing = File_Missing + 1
End If
'Basic error handling procedure that retains function.
If File_Missing > 0 Then
MsgBox ("The following files could not be found. Please check the file paths and try again" & vbCrLf & Join(arr, vbCrLf))
Else
MsgBox "Files opened successfully."
End If
Exit Sub
ErrHand: MsgBox "There has been a critical error with opening the chosen workbooks. If the problem persists, please contact your administrator for assistance."
End Sub
Edit with pictures:
A screenshot of the message box current output
How I'd like the message box to look
Since you just use that array to Join it later you could also just use a String variable MyMissingFiles instead of that array and append the file name.
You even don't need to count the files in File_Missing if this number is not of your interest.
Dim MyMissingFiles As String
If Not Dir(i, vbDirectory) = vbNullString Then
Workbooks.Open (i)
Windows(j).Visible = False
Else
MyMissingFiles = MyMissingFiles & vbCrLf & "Lux file"
End If
' … all the others accordingly here …
If MyMissingFiles <> vbNullString Then
MsgBox ("The following files could not be found. Please check the file paths and try again" & MyMissingFiles)
Else
MsgBox "Files opened successfully."
End If
I need some fresh eyes. I have been working on this incrementally and go from having it work to broken. At this point my eyes are crossing and I could use some help. Column H in this spreadsheet contains a machine id and column I is a date. I want it to display nothing if both H and I are blank (This is the point where I broke it most recently and decided to ask for help. This logic is not include.) If either H or I but not both have a value, it will display "NO". If both H and I have values, it will call a custom function that will create the directory if it does not already exist. Additionally, I want to display "YES" if the directory is created or exists. All of the functionality was working before I tried to display nothing if both H and I were empty.
This is the formula I am working with:
=IF(COUNTA(H21:I21)<>COLUMNS(H21:I21), "NO",IF(CREATEDIR(CONCATENATE(TEXT(I21,"yyyy"),"\",TEXT(I21,"m-d-yy"),"\",H21))=0,"YES", "NO"))
And this is the VBA function I am using(path details omitted)
Function CREATEDIR(dateId)
If Len(Dir("Z:\pathname\" & dateId, vbDirectory)) = 0 Then
MkDir "Z:\pathname\" & dateId
End If
End Function:
Update your UDF to the following so that it can build the full folder path provided in case it doesn't exist (this will handle both network folder paths such as \\server\folder\subfolders\ as well as local or mapped folder paths such as Z:\pathname\). You'll need to set the sBeginPath to whatever it should actually be:
Function CREATEDIR(dateID) As String
Dim sBeginPath As String
Dim sBuildPath As String
Dim vFolder As Variant
Dim i As Long
sBeginPath = "C:\Test\"
If Right(sBeginPath, 1) <> "\" Then sBeginPath = sBeginPath & "\"
For Each vFolder In Split(sBeginPath & dateID, "\")
If Len(vFolder) > 0 Then
If Len(sBuildPath) = 0 Then
If i > 0 Then
sBuildPath = "\\" & vFolder & "\"
Else
sBuildPath = vFolder
End If
Else
If i > 0 Then
sBuildPath = sBuildPath & vFolder & "\"
i = i + 1
Else
sBuildPath = sBuildPath & "\" & vFolder
End If
End If
If (Len(sBuildPath) > 0) And (i = 0 Or i >= 3) Then
If Len(Dir(sBuildPath, vbDirectory)) = 0 Then MkDir sBuildPath
End If
Else
i = i + 1
End If
Next vFolder
CREATEDIR = "YES"
End Function
Then update your formula to the following (using the CHOOSE method as suggested by #pnuts):
=CHOOSE(COUNTA(H21:I21)+1,"", "NO",CREATEDIR(CONCATENATE(TEXT(I21,"yyyy"),"\",TEXT(I21,"m-d-yy"),"\",H21)))
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
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.