counting folders

  • Thread starter Thread starter tim64
  • Start date Start date
a,

I believe some of the problems came from the
possibility that t64 may be using Excel 95 (version 7).
That version does not have the "Split" function.

Also,"Windows Script Host" and the Scripting.FileSystemObject
were not included with Windows 95.

Jim Cone
San Francisco, USA


"anilsolipuram"
<[email protected]>
wrote in message

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
 
jim, I use excel 2003 so that can't be the problem.

the code you sent to me got an error (see below)

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)
<------------------------------------------ ByRef argument type
mismatch
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(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

latest_folder = strLatest

Set objFSO = Nothing
Set objFolder = Nothing
Set objSubFold = Nothing
End Function
 
tim64,

You/me are passing a Variant to a function that requires a String.
Excel won't let you convert variants to another data type,
unless they are passed ByVal.

Change the function's first line from...
Function latest_folder(ByRef strPath As String) As String
To...
Function latest_folder(ByVal strPath As String) As String
or
Change the data type of temp3 from Variant to String.
'--------
Curious, why this...FileFormat:=xlExcel7

Jim Cone
San Francisco, USA



message
jim, I use excel 2003 so that can't be the problem.
the code you sent to me got an error (see below)

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)
<------------------------------------------ ByRef argument type

-snip-

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
'------------------------
 
Back
Top