counting folders

  • Thread starter Thread starter tim64
  • Start date Start date
T

tim64

i have this code, and I want it to search for the latest folder that has
its root folder as part of its name. (example) in the folder
project_test (root folder) there are the folders project_test0001,
project_test0002, project_test0003, project_test0004, folder1, and
folder2. I want the latest folder that it counts is project_test0004.
(I do not have any folders named project_test - project_test0004 or
folder1 and 2 that was just for an example I'll use this in many
folders.) Also this is only part of the code the rest of the code is
ok.

Function lastest_folder(p As Variant, ar2 As Variant)
Dim t1 As Variant
t = Dir(p & ar2 & "*.*", vbDirectory)
While t <> ""
If (t <> "") Then
t1 = t
End If
t = Dir()
Wend
If t1 = "" Then
t1 = t
End If
lastest_folder = t1
End Function
 
the below function will get the latest_folder, the

you use it like

latest=latest_folder("c:\project\","project")

msgbox latest

so latest will be latest folder which is like the root folder.


Function lastest_folder(p As Variant, ar2 As Variant)
Dim t1 As Variant
t = Dir(p & ar2 & "*.*", vbDirectory)
While t <> ""
If (t <> "") Then
t1 = t
End If
t = Dir()
Wend
If t1 = "" Then
t1 = t
End If
lastest_folder = t1
End Function
 
execute the macro and see the result.

let say you have folder c:\test\name, in which you sub folder name_001,
name_002,name_003, so now latest_folder will return name_003 as that is
the latest folder.


macro popup the file dialog to select the folder, and then it will
retrieve the latest folder which is like root_folder001 pattern
 
tim64,

Does this do what you want?
'---------------------------------
Function LatestFolder(ByRef strPath As String) As String
'Jim Cone - San Francisco, USA - June 29, 2005
'Requires a project reference to the "Microsoft Scripting Runtime" library.
'Displays the latest folder name in the strPath folder,
'if the folder name contains the strPath folder name.

Dim objFSO As Scripting.FileSystemObject
Dim objFolder As Scripting.Folder
Dim objSubFold As Scripting.Folder
Dim strParentName As String
Dim strLatest As String
Dim varDate As Variant

Set objFSO = New Scripting.FileSystemObject
Set objFolder = objFSO.GetFolder(strPath)
strParentName = objFolder.Name
strLatest = "No folders"

For Each objSubFold In objFolder.SubFolders
If InStr(1, objSubFold.Name, strParentName, vbTextCompare) > 0 Then
If objSubFold.DateLastModified > varDate Then
varDate = objSubFold.DateLastModified
strLatest = objSubFold.Name
End If
End If
Next 'objFile

LatestFolder = strLatest & " - " & varDate

Set objFSO = Nothing
Set objFolder = Nothing
Set objSubFold = Nothing
End Function
'------------------------

Call it like this...
Sub CallTheFunction()
Dim strFolderPath As String
strFolderPath = _
"C:\Documents and Settings\user\My Documents\Excel Files"
MsgBox LatestFolder(strFolderPath)
End Sub
'------------------------


message i have this code, and I want it to search for the latest folder that has
its root folder as part of its name. (example) in the folder
project_test (root folder) there are the folders project_test0001,
project_test0002, project_test0003, project_test0004, folder1, and
folder2. I want the latest folder that it counts is project_test0004.
(I do not have any folders named project_test - project_test0004 or
folder1 and 2 that was just for an example I'll use this in many
folders.) Also this is only part of the code the rest of the code is
ok.

Function lastest_folder(p As Variant, ar2 As Variant)
Dim t1 As Variant
t = Dir(p & ar2 & "*.*", vbDirectory)
While t <> ""
If (t <> "") Then
t1 = t
End If
t = Dir()
Wend
If t1 = "" Then
t1 = t
End If
lastest_folder = t1
End Function
 
I don't need the second macro I have the folder defined in another part
of the code. it does it in PickFolder. so I don't need some of the
code.
and this is why it's called lastest_folder. (by the way, it doesn't
work with my
code )

Sub ListFilesInFolder()
Dim teMp, temp1, temp2, temp3, temp4, temp5, temp6, temp7, temp8,
temp9, temp10, FILE_PATH As Variant
Dim c As Integer
Dim t1(20) As Variant
Application.DisplayAlerts = False
Dim path As Variant
path = PickFolder("C:\") & "\"
t = Dir(path & "*detail*.htm")
Dim c1 As Integer
While t <> ""
t1(c1) = t
t = Dir()
c1 = c1 + 1
Wend
c = 0
For i = 0 To 20
If t1(i) = "" Then
GoTo a:
End If
If c = 0 Then
temp3 = path
temp4 = Split(temp3, "\")
temp5 = temp4(UBound(temp4) - 1)
temp6 = lastest_folder(temp3, temp5) 'finds the latest folder that was
created
If temp6 <> "" Then
temp10 = Split(temp6, temp5)
temp7 = CInt(temp10(1))
End If
If Err.Description <> "" Then
temp8 = 1
temp9 = Format(temp8, "000#")
Else
temp8 = temp7 + 1
temp9 = Format(temp8, "000#")
End If
MkDir temp3 & temp5 & temp9
c = 1
End If
Application.DisplayAlerts = False
Workbooks.OpenText path & t1(i)
ActiveWorkbook.SaveAs Filename:= _
ActiveWorkbook.path & "\" & temp5 & temp9 & "\" & ActiveWorkbook.Name &
".xls", _
FileFormat:=xlExcel7, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Save
ActiveWorkbook.Close
Next
a:
Application.DisplayAlerts = True


End Sub

Function lastest_folder(p As Variant, ar2 As Variant)
Dim t1 As Variant
t = Dir(p & ar2 & "*.*", vbDirectory)
While t <> ""
If (t <> "") Then
t1 = t
End If
t = Dir()
Wend
If t1 = "" Then
t1 = t
End If
lastest_folder = t1
End Function

Function PickFolder(strStartDir As Variant) As String
Application.DisplayAlerts = False
Dim SA As Object, f As Object
Set SA = CreateObject("Shell.Application")
Set f = SA.BrowseForFolder(0, "Choose a folder", 0, strStartDir)
If (Not f Is Nothing) Then
PickFolder = f.Items.Item.path
End If
Set f = Nothing
Set SA = Nothing
End Function
 
What is exactly not working,

it worked for me it is creating test004 for me if latest folder is
test003
 
the code I just posted works when there is only project_test0001,
project_test0002, project_test0003, project_test0004 not
project_test0001,
project_test0002, project_test0003, project_test0004, folder1 and
folder2.
thats why I need it to choose the latest folder with the root name in
it.
 
So if there is folder1 and folder2, is it possible that folder2 can b
the latest folder. I thought we need to consider folders lik
project_test--- only, i.e folders with root_folder name
 
You want the latest folder to be project_test0004, assuming that roo
folder is project_test.

That is what my code is getting.

what are you gettting, are you getting folder2
 
so it gets folder2 eventhough the parent folder is project_test.

ok execute the below macro and let me know what message popsup.


Sub ListFilesInFolder()
Dim teMp, temp1, temp2, temp3, temp4, temp5, temp6, temp7, temp8,
temp9, temp10, FILE_PATH As Variant
Dim c As Integer
Dim t1(20) As Variant
Application.DisplayAlerts = False
Dim path As Variant
path = PickFolder("C:\") & "\"
t = Dir(path & "*detail*.htm")
Dim c1 As Integer
While t <> ""
t1(c1) = t
t = Dir()
c1 = c1 + 1
Wend
c = 0
For i = 0 To 20
If t1(i) = "" Then
GoTo a:
End If
If c = 0 Then
temp3 = path
temp4 = Split(temp3, "\")
temp5 = temp4(UBound(temp4) - 1)
temp6 = lastest_folder(temp3, temp5) 'finds the latest folder that was
created
msgbox "latest folder:" & temp6 & "parent folder path:" & temp3 &
"parent folder:" & temp5
If temp6 <> "" Then
temp10 = Split(temp6, temp5)
temp7 = CInt(temp10(1))
End If
If Err.Description <> "" Then
temp8 = 1
temp9 = Format(temp8, "000#")
Else
temp8 = temp7 + 1
temp9 = Format(temp8, "000#")
End If
MkDir temp3 & temp5 & temp9
c = 1
End If
Application.DisplayAlerts = False
Workbooks.OpenText path & t1(i)
ActiveWorkbook.SaveAs Filename:= _
ActiveWorkbook.path & "\" & temp5 & temp9 & "\" & ActiveWorkbook.Name &
".xls", _
FileFormat:=xlExcel7, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Save
ActiveWorkbook.Close
Next
a:
Application.DisplayAlerts = True


End Sub

Function lastest_folder(p As Variant, ar2 As Variant)
Dim t1 As Variant
t = Dir(p & ar2 & "*.*", vbDirectory)
While t <> ""
If (t <> "") Then
t1 = t
End If
t = Dir()
Wend
If t1 = "" Then
t1 = t
End If
lastest_folder = t1
End Function

Function PickFolder(strStartDir As Variant) As String
Application.DisplayAlerts = False
Dim SA As Object, f As Object
Set SA = CreateObject("Shell.Application")
Set f = SA.BrowseForFolder(0, "Choose a folder", 0, strStartDir)
If (Not f Is Nothing) Then
PickFolder = f.Items.Item.path
End If
Set f = Nothing
Set SA = Nothing
End Function
 
what i got was this "latest folder: project_testexport050616-120000.as
parent folder path: C:\working\Webposition3\results\project_test
parent folder: project_test
 
it seems like that file is the one causing all the problems, but I can'
get rid of it because i need it
 
try this now

Sub ListFilesInFolder()
Dim teMp, temp1, temp2, temp3, temp4, temp5, temp6, temp7, temp8,
temp9, temp10, FILE_PATH As Variant
Dim c As Integer
Dim t1(20) As Variant
Application.DisplayAlerts = False
Dim path As Variant
path = PickFolder("C:\") & "\"
t = Dir(path & "*detail*.htm")
Dim c1 As Integer
While t <> ""
t1(c1) = t
t = Dir()
c1 = c1 + 1
Wend
c = 0
For i = 0 To 20
If t1(i) = "" Then
GoTo a:
End If
If c = 0 Then
temp3 = path
temp4 = Split(temp3, "\")
temp5 = temp4(UBound(temp4) - 1)
temp6 = latest_folder(temp3, temp5) 'finds the latest folder that was
created
msgbox "latest folder:" & temp6 & "parent folder path:" & temp3 &
"parent folder:" & temp5
If temp6 <> "" Then
temp10 = Split(temp6, temp5)
temp7 = CInt(temp10(1))
End If
If Err.Description <> "" Then
temp8 = 1
temp9 = Format(temp8, "000#")
Else
temp8 = temp7 + 1
temp9 = Format(temp8, "000#")
End If
MkDir temp3 & temp5 & temp9
c = 1
End If
Application.DisplayAlerts = False
Workbooks.OpenText path & t1(i)
ActiveWorkbook.SaveAs Filename:= _
ActiveWorkbook.path & "\" & temp5 & temp9 & "\" & ActiveWorkbook.Name &
".xls", _
FileFormat:=xlExcel7, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Save
ActiveWorkbook.Close
Next
a:
Application.DisplayAlerts = True


End Sub


Function PickFolder(strStartDir As Variant) As String
Application.DisplayAlerts = False
Dim SA As Object, f As Object
Set SA = CreateObject("Shell.Application")
Set f = SA.BrowseForFolder(0, "Choose a folder", 0, strStartDir)
If (Not f Is Nothing) Then
PickFolder = f.Items.Item.path
End If
Set f = Nothing
Set SA = Nothing
End Function




Function latest_folder(p As Variant, ar2 As Variant)
Dim t1 As Variant
t = Dir(p & ar2 & "*", vbDirectory)
While t <> ""
If (t <> "" And InStr(1, t, ".", vbTextCompare) = 0) Then
t1 = t
End If
t = Dir()
Wend
If t1 = "" Then
t1 = t
End If
latest_folder = t1
End Function
 
Jim macro works perfectly, my macro of finding latest folder might fail
sometimes, but Jim's is correct method to find latest folder.

Thanks Jim

updated code



Sub ListFilesInFolder()
Dim teMp, temp1, temp2, temp3, temp4, temp5, temp6, temp7, temp8,
temp9, temp10, FILE_PATH As Variant
Dim c As Integer
Dim t1(20) As Variant
Application.DisplayAlerts = False
Dim path As Variant
path = PickFolder("C:\") & "\"
t = Dir(path & "*detail*.htm")
Dim c1 As Integer
While t <> ""
t1(c1) = t
t = Dir()
c1 = c1 + 1
Wend
c = 0
For i = 0 To 20
If t1(i) = "" Then
GoTo a:
End If
If c = 0 Then
temp3 = path
temp4 = Split(temp3, "\")
temp5 = temp4(UBound(temp4) - 1)
temp6 = latest_folder(temp3) 'finds the latest folder that was created
msgbox "latest folder:" & temp6 & "parent folder path:" & temp3 &
"parent folder:" & temp5
If temp6 <> "" Then
temp10 = Split(temp6, temp5)
temp7 = CInt(temp10(1))
End If
If Err.Description <> "" Then
temp8 = 1
temp9 = Format(temp8, "000#")
Else
temp8 = temp7 + 1
temp9 = Format(temp8, "000#")
End If
MkDir temp3 & temp5 & temp9
c = 1
End If
Application.DisplayAlerts = False
Workbooks.OpenText path & t1(i)
ActiveWorkbook.SaveAs Filename:= _
ActiveWorkbook.path & "\" & temp5 & temp9 & "\" & ActiveWorkbook.Name &
".xls", _
FileFormat:=xlExcel7, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Save
ActiveWorkbook.Close
Next
a:
Application.DisplayAlerts = True


End Sub


Function PickFolder(strStartDir As Variant) As String
Application.DisplayAlerts = False
Dim SA As Object, f As Object
Set SA = CreateObject("Shell.Application")
Set f = SA.BrowseForFolder(0, "Choose a folder", 0, strStartDir)
If (Not f Is Nothing) Then
PickFolder = f.Items.Item.path
End If
Set f = Nothing
Set SA = Nothing
End Function




Function LatestFolder(ByRef strPath As String) As String
'Jim Cone - San Francisco, USA - June 29, 2005
'Requires a project reference to the "Microsoft Scripting Runtime"
library.
'Displays the latest folder name in the strPath folder,
'if the folder name contains the strPath folder name.

Dim objFSO As Scripting.FileSystemObject
Dim objFolder As Scripting.Folder
Dim objSubFold As Scripting.Folder
Dim strParentName As String
Dim strLatest As String
Dim varDate As Variant

Set objFSO = New Scripting.FileSystemObject
Set objFolder = objFSO.GetFolder(strPath)
strParentName = objFolder.Name
strLatest = "No folders"

For Each objSubFold In objFolder.SubFolders
If InStr(1, objSubFold.Name, strParentName, vbTextCompare) > 0 Then
If objSubFold.DateLastModified > varDate Then
varDate = objSubFold.DateLastModified
strLatest = objSubFold.Name
End If
End If
Next 'objFile

LatestFolder = strLatest

Set objFSO = Nothing
Set objFolder = Nothing
Set objSubFold = Nothing
End Function
 
Back
Top