fixing code

[timmy64 - ExcelForums.com]

Hi, I have this code that first chooses a folder, then it converts the
files in the folder with the word "detail" in its name, then it saves
them in a new folder it creates with the same name as its root folder
but with a number at the end of it. It's been working up until now,
but for some reason it gets an error now (see below)



Sub ListFilesInFolder()

Application.DisplayAlerts = False
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))
<-------------------------------------------------------- error:
type mismatch
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

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

Application.DisplayAlerts = True

fill_file_names

a:

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

 

[Rich_z]

Help us a bit here.... What's the error, and which line of code does i
error on

 

[tim64]

Sub ListFilesInFolder()

Application.DisplayAlerts = False
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))
<-------------------------------------------------------- error: type
mismatch
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

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

Application.DisplayAlerts = True

fill_file_names

a:

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

 

[Rich_z]

Hi Tim,

The error is because the variant can't be changed to an Integer.
Apologies for being blind before!!

This means that your path string has fallen outside of the parameter
that you originally used to create your algorithm to split it up.

Have you walked through the code with the string that's causing th
problem ? I find that generally helps.

Ric