#1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2
Default fixing code

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

  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default fixing code


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


--
tim64
------------------------------------------------------------------------
tim64's Profile: http://www.excelforum.com/member.php...o&userid=23295
View this thread: http://www.excelforum.com/showthread...hreadid=383743

  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default fixing code


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

--
Rich_
-----------------------------------------------------------------------
Rich_z's Profile: http://www.excelforum.com/member.php...fo&userid=2473
View this thread: http://www.excelforum.com/showthread.php?threadid=38374

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Fixing a link hakan Excel Discussion (Misc queries) 1 April 28th 08 03:16 PM
HELP fixing GPA formula's JohnG Excel Worksheet Functions 7 June 14th 07 06:42 AM
Fixing Hyphens Good Intentions Excel Worksheet Functions 2 April 10th 06 07:39 PM
Fixing a formula Boethius1 Excel Discussion (Misc queries) 2 January 18th 06 11:38 PM
Help with fixing formula Pat Excel Worksheet Functions 4 December 21st 04 11:38 AM


All times are GMT +1. The time now is 02:57 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"