counting folders

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
 
A

anilsolipuram

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
 
A

anilsolipuram

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
 
J

Jim Cone

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
 
T

tim64

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
 
A

anilsolipuram

What is exactly not working,

it worked for me it is creating test004 for me if latest folder is
test003
 
T

tim64

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.
 
A

anilsolipuram

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
 
A

anilsolipuram

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
 
A

anilsolipuram

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
 
T

tim64

what i got was this "latest folder: project_testexport050616-120000.as
parent folder path: C:\working\Webposition3\results\project_test
parent folder: project_test
 
T

tim64

it seems like that file is the one causing all the problems, but I can'
get rid of it because i need it
 
A

anilsolipuram

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
 
A

anilsolipuram

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

fixing code 3
open file from folder save in new folder 20
Create list of folders 1
How to get list of subfolders, including shortcuts to folders? 1
find newest file in all sub folders 1
Shell Out Failing 6
Data range in Array worksheets 2
Dir function resetting 7

Top