open file from folder save in new folder
 

I have this code and I want it to open a file in a directory that I
choose (it does that already), and then I wunt it to create a
sub-folder in the folder I chose with the original folders name plus a
number. (example) I choose a folder named project_test then it converts
the file, in the folder, detail.htm to detail.htm.wk4. Then it creates
the sub-folder project_test0001 then saves detail.htm.wk4 in it. Then
the next time I run ConvertFiles ,when it creates the sub-folder, it
creates project_test0002, and when it has reached the tenth time it
creates it as project_test0010 etc.



Code:
--------------------


Sub ConvertFiles()
'
'
Application.DisplayAlerts = False

'
Dim vrtSelectedItem As Variant

Dim FileToOpen As String
'Declare a variable as a FileDialog object.
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.Title = "Cool Application"
fd.InitialFileName = "Working"
If fd.Show = -1 Then
For a = 1 To fd.SelectedItems.Count
MsgBox fd.SelectedItems(a)
Dim NextFile As String


NextFile = Dir(fd.SelectedItems(a) & "\*detail*.htm")
Do While NextFile < ""
Workbooks.Open Filename:=NextFile
ActiveWorkbook.SaveAs Filename:= _
NextFile & ".wk4", _
FileFormat:=xlWK4, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Save
ActiveWorkbook.Close
NextFile = Dir()


Loop
Next
End If

Application.DisplayAlerts = True


End Sub


--------------------


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

open file from folder save in new folder
 

Backup the workbooks before testing this macro

Excel version I have is 2000 so couldnot test the macro



Sub ConvertFiles()
'
'
Application.DisplayAlerts = False
Dim T As Integer
'
T = 1
Dim vrtSelectedItem As Variant

Dim FileToOpen As String
'Declare a variable as a FileDialog object.
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.Title = "Cool Application"
fd.InitialFileName = "Working"
If fd.Show = -1 Then
For a = 1 To fd.SelectedItems.Count
MsgBox fd.SelectedItems(a)
Dim NextFile As String
T = 1

NextFile = Dir(fd.SelectedItems(a) & "\*detail*.htm")
Do While NextFile < ""
Workbooks.Open Filename:=NextFile

If T < 10 Then
MkDir ActiveWorkbook.Path & "\ PROJECT_TEST000" & T
ActiveWorkbook.SaveAs Filename:= _
ActiveWorkbook.Path & "\ PROJECT_TEST000" & T & "\" &
ActiveWorkbook.Name & ".wk4", _
FileFormat:=xlWK4, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Else
MkDir ActiveWorkbook.Path & "\ PROJECT_TEST00" & T
ActiveWorkbook.SaveAs Filename:= _
ActiveWorkbook.Path & "\ PROJECT_TEST00" & T & "\" &
ActiveWorkbook.Name & ".wk4", _
FileFormat:=xlWK4, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End If
ActiveWorkbook.Save
ActiveWorkbook.Close
NextFile = Dir()
T = T + 1

Loop
Next
End If

Application.DisplayAlerts = True


End Sub


--
anilsolipuram
------------------------------------------------------------------------
anilsolipuram's Profile: http://www.excelforum.com/member.php...o&userid=16271
View this thread: http://www.excelforum.com/showthread...hreadid=379459

open file from folder save in new folder
 

it looks good, but I don't have a folder named project_test that wa
for an example, I'll have hundreds of different folders I'll use thi
in and, I'll have between 1 and 10 files in then with the name "detail
in it and, I wunt them all to go to the new folder that is created. Als
I'll probly have hundreds of folders created because I'm going to us
this alot so it will be like project_test1839(example) eventually.
Sorry I didn't clerify that earlie

--
tim6
-----------------------------------------------------------------------
tim64's Profile: http://www.excelforum.com/member.php...fo&userid=2329
View this thread: http://www.excelforum.com/showthread.php?threadid=37945

open file from folder save in new folder
 

Backup your workbooks before using this macro
Try this macro

Sub ConvertFiles()
'
'
Application.DisplayAlerts = False
Dim T As Integer
'
T = 1
Dim vrtSelectedItem As Variant

Dim FileToOpen As String
'Declare a variable as a FileDialog object.
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.Title = "Cool Application"
fd.InitialFileName = "Working"
If fd.Show = -1 Then
For a = 1 To fd.SelectedItems.Count
MsgBox fd.SelectedItems(a)
Dim NextFile As String
T = 1

NextFile = Dir(fd.SelectedItems(a) & "\*detail*.htm")
Dim ar1, ar2 As Variant
ar1 = Split(fd.SelectedItems(a), "\")
ar2 = ar1(UBound(ar1))
Do While NextFile < ""
Workbooks.Open Filename:=NextFile

If T < 10 Then
MkDir ActiveWorkbook.Path & "\" & ar2 & "000" & T
ActiveWorkbook.SaveAs Filename:= _
ActiveWorkbook.Path & "\" & ar2 & "000" & T & "\" &
ActiveWorkbook.Name & ".wk4", _
FileFormat:=xlWK4, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Else
MkDir ActiveWorkbook.Path & "\" & ar2 & "00" & T
ActiveWorkbook.SaveAs Filename:= _
ActiveWorkbook.Path & "\" & ar2 & "00" & T & "\" &
ActiveWorkbook.Name & ".wk4", _
FileFormat:=xlWK4, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End If
ActiveWorkbook.Save
ActiveWorkbook.Close
NextFile = Dir()
T = T + 1

Loop
Next
End If

Application.DisplayAlerts = True


End Sub


--
anilsolipuram
------------------------------------------------------------------------
anilsolipuram's Profile: http://www.excelforum.com/member.php...o&userid=16271
View this thread: http://www.excelforum.com/showthread...hreadid=379459

open file from folder save in new folder
 

thats almost to what I want but, when ConvertFiles runs I only want i
to create one sub-folder per run and I want all the converted files t
go into it. (example) I have four files detail1.htm, detail2.htm
detail3.htm, detail4.htm and, in the folder project_test there ar
sub-folders project_test0001 - project_test3829. So when I ru
ConvertFiles it converts the four files then it saves them to th
folder project_test3830 (after it makes it). So the next time I ru
ConvertFiles it saves the files in project_test3831 etc

--
tim6
-----------------------------------------------------------------------
tim64's Profile: http://www.excelforum.com/member.php...fo&userid=2329
View this thread: http://www.excelforum.com/showthread.php?threadid=37945

open file from folder save in new folder
 

I added 1 more function to the end



Sub ConvertFiles()
'
'
Dim temp, temp1, temp2, temp3, temp4 As Variant
Application.DisplayAlerts = False
Dim t As Integer
'
t = 1
Dim vrtSelectedItem As Variant

Dim FileToOpen As String
'Declare a variable as a FileDialog object.
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.Title = "Cool Application"
fd.InitialFileName = "Working"
If fd.Show = -1 Then
For a = 1 To fd.SelectedItems.Count
Dim NextFile As String
t = 1

NextFile = Dir(fd.SelectedItems(a) & "\*detail*.htm")
Dim ar1, ar2 As Variant
ar1 = Split(fd.SelectedItems(a), "\")
ar2 = ar1(UBound(ar1))
temp = last_filename(ActiveWorkbook.Path & "\", ar2)
temp1 = Split(temp, ar2)
temp2 = CInt(temp1(1))
temp3 = temp1 + 1
temp4 = Format(temp3, "000#")
MkDir ActiveWorkbook.Path & "\" & ar2 & temp4
Do While NextFile < ""
Workbooks.Open Filename:=NextFile
ActiveWorkbook.SaveAs Filename:= _
ActiveWorkbook.Path & "\" & ar2 & temp4 & "\" &
ActiveWorkbook.Name & ".wk4", _
FileFormat:=xlWK4, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Save
ActiveWorkbook.Close
NextFile = Dir()
t = t + 1

Loop
Next
End If

Application.DisplayAlerts = True


End Sub


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


--
anilsolipuram
------------------------------------------------------------------------
anilsolipuram's Profile: http://www.excelforum.com/member.php...o&userid=16271
View this thread: http://www.excelforum.com/showthread...hreadid=379459

open file from folder save in new folder
 

I got an error (see below)



Sub ConvertFiles()
'
'
Dim temp, temp1, temp2, temp3, temp4 As Variant
Application.DisplayAlerts = False
Dim t As Integer
'
t = 1
Dim vrtSelectedItem As Variant

Dim FileToOpen As String
'Declare a variable as a FileDialog object.
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.Title = "Cool Application"
fd.InitialFileName = "Working"
If fd.Show = -1 Then
For a = 1 To fd.SelectedItems.Count
Dim NextFile As String
t = 1

NextFile = Dir(fd.SelectedItems(a) & "\*detail*.htm")
Dim ar1, ar2 As Variant
ar1 = Split(fd.SelectedItems(a), "\")
ar2 = ar1(UBound(ar1))
temp = last_filename(ActiveWorkbook.Path & "\", ar2)
temp1 = Split(temp, ar2)
temp2 = CInt(temp1(1))
<-------------------------------------------Run-time error '9':
subscript out of range
temp3 = temp1 + 1

temp4 = Format(temp3, "000#")
MkDir ActiveWorkbook.Path & "\" & ar2 & temp4
Do While NextFile < ""
Workbooks.Open Filename:=NextFile
ActiveWorkbook.SaveAs Filename:= _
ActiveWorkbook.Path & "\" & ar2 & temp4 & "\" & ActiveWorkbook.Name &
".wk4", _
FileFormat:=xlWK4, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Save
ActiveWorkbook.Close
NextFile = Dir()
t = t + 1

Loop
Next
End If

Application.DisplayAlerts = True


End Sub


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


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

open file from folder save in new folder
 

Backup the workbooks before using the macros.

Since I don't have excel 2002, i am not testing the code before pasting
it.


Sub ConvertFiles()
'
'
Dim temp, temp1, temp2, temp3, temp4 As Variant
Application.DisplayAlerts = False
Dim t As Integer
'
t = 1
Dim vrtSelectedItem As Variant

Dim FileToOpen As String
'Declare a variable as a FileDialog object.
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.Title = "Cool Application"
fd.InitialFileName = "Working"
If fd.Show = -1 Then
For a = 1 To fd.SelectedItems.Count
Dim NextFile As String
t = 1

NextFile = Dir(fd.SelectedItems(a) & "\*detail*.htm")
Dim ar1, ar2 As Variant
ar1 = Split(fd.SelectedItems(a), "\")
ar2 = ar1(UBound(ar1))
temp = last_filename(ActiveWorkbook.Path & "\", ar2)
temp1 = Split(temp, ar2)
on error resume next
temp2 = CInt(temp1(1))
if err.description<"" then
err.clear
temp3=1
temp4 = Format(temp3, "000#")
else
temp3 = temp2 + 1
temp4 = Format(temp3, "000#")
end if
MkDir ActiveWorkbook.Path & "\" & ar2 & temp4
Do While NextFile < ""
Workbooks.Open Filename:=NextFile
ActiveWorkbook.SaveAs Filename:= _
ActiveWorkbook.Path & "\" & ar2 & temp4 & "\" & ActiveWorkbook.Name &
".wk4", _
FileFormat:=xlWK4, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Save
ActiveWorkbook.Close
NextFile = Dir()
t = t + 1

Loop
Next
End If

Application.DisplayAlerts = True


End Sub


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


--
anilsolipuram
------------------------------------------------------------------------
anilsolipuram's Profile: http://www.excelforum.com/member.php...o&userid=16271
View this thread: http://www.excelforum.com/showthread...hreadid=379459

open file from folder save in new folder
 

the code dosen't work
1. it doesn't save as a wk4 file
2. it doesn't create a sub-folder
3. it goes in a constant loop of opening the same file and closeing it
over and over again

mabye it's because of the runtime error that poped up earlier(it
doesn't anymore though)


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

open file from folder save in new folder
 

try it now

Sub ConvertFiles()
'
'
Dim temp, temp1, temp2, temp3, temp4 As Variant
Application.DisplayAlerts = False
Dim t As Integer
'
t = 1
Dim vrtSelectedItem As Variant

Dim FileToOpen As String
'Declare a variable as a FileDialog object.
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.Title = "Cool Application"
fd.InitialFileName = "Working"
If fd.Show = -1 Then
For a = 1 To fd.SelectedItems.Count
Dim NextFile As String
t = 1

NextFile = Dir(fd.SelectedItems(a) & "\*detail*.htm")
Dim ar1, ar2 As Variant
ar1 = Split(fd.SelectedItems(a), "\")
ar2 = ar1(UBound(ar1))
temp = last_filename(fd.SelectedItems(a) & "\", ar2)
temp1 = Split(temp, ar2)
on error resume next
temp2 = CInt(temp1(1))
if err.description<"" then
err.clear
temp3=1
temp4 = Format(temp3, "000#")
else
temp3 = temp2 + 1
temp4 = Format(temp3, "000#")
end if
MkDir fd.SelectedItems(a) & "\" & ar2 & temp4
Do While NextFile < ""
Workbooks.Open Filename:=NextFile
ActiveWorkbook.SaveAs Filename:= _
ActiveWorkbook.Path & "\" & ar2 & temp4 & "\" & ActiveWorkbook.Name &
".wk4", _
FileFormat:=xlWK4, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Save
ActiveWorkbook.Close
NextFile = Dir()
t = t + 1

Loop
Next
End If

Application.DisplayAlerts = True


End Sub


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


--
anilsolipuram
------------------------------------------------------------------------
anilsolipuram's Profile: http://www.excelforum.com/member.php...o&userid=16271
View this thread: http://www.excelforum.com/showthread...hreadid=379459

open file from folder save in new folder
 

it's good but it only creates the sub-folder one time
(example) I run ConvertFiles and it creates project_test0001 and puts
the converted files in it. the second time I run ConvertFiles it
doesn't make project_test0002 and puts the converted files in
project_test0001

also at the end it goes in a continuous loop of opening the same
"detail" files and saving them over and over again


Sub ConvertFiles()
'
'
Dim temp, temp1, temp2, temp3, temp4 As Variant
Application.DisplayAlerts = False
Dim t As Integer
'
t = 1
Dim vrtSelectedItem As Variant

Dim FileToOpen As String
'Declare a variable as a FileDialog object.
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.Title = "Cool Application"
fd.InitialFileName = "Working"
If fd.Show = -1 Then
For a = 1 To fd.SelectedItems.Count
Dim NextFile As String
t = 1

NextFile = Dir(fd.SelectedItems(a) & "\*detail*.htm")
Dim ar1, ar2 As Variant
ar1 = Split(fd.SelectedItems(a), "\")
ar2 = ar1(UBound(ar1))
temp = last_filename(fd.SelectedItems(a) & "\", ar2)
temp1 = Split(temp, ar2)
on error resume next
temp2 = CInt(temp1(1))
if err.description<"" then
err.clear
temp3=1
temp4 = Format(temp3, "000#")
else
temp3 = temp2 + 1
temp4 = Format(temp3, "000#")
end if
MkDir fd.SelectedItems(a) & "\" & ar2 & temp4
Do While NextFile < ""
Workbooks.Open Filename:=NextFile
ActiveWorkbook.SaveAs Filename:= _
ActiveWorkbook.Path & "\" & ar2 & temp4 & "\" & ActiveWorkbook.Name &
".wk4", _ <----------------(it keeps looping here)
FileFormat:=xlWK4, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Save
ActiveWorkbook.Close
NextFile = Dir()
t = t + 1

Loop
Next
End If

Application.DisplayAlerts = True


End Sub


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


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

open file from folder save in new folder
 

The code was not compatible in excel 2000, so had to change it make it
compatilbe to excel 2000

macro does:

1) open file dialog
2) go to file folder and select all the files you want to copy into new
created subfolder and click open.
3) creates new subfolder and copies selected files into new folder
4) next time you execute the macro, it would create subfolder like
project_file0001 then project_file0002 .......



Sub ListFilesInFolder()
Dim teMp, temp1, temp2, temp3, temp4, temp5, temp6, temp7, temp8,
temp9, temp10, FILE_PATH As Variant
t = Application.GetOpenFilename(FileFilter:="HTML files (*.html),
*.htm", FilterIndex:=2, MultiSelect:=True)
If UBound(t) 0 Then
teMp = Split(t(1), "\")
temp1 = teMp(UBound(teMp))
temp2 = Split(t(1), temp1)
temp3 = temp2(0)
temp4 = Split(temp3, "\")
temp5 = temp4(UBound(temp4) - 1)
temp6 = last_filename(temp3, 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
For I = 1 To UBound(t)
Application.DisplayAlerts = False
Workbooks.OpenText t(I)
ActiveWorkbook.SaveAs Filename:= _
ActiveWorkbook.Path & "\" & temp5 & temp9 & "\" &
ActiveWorkbook.Name & ".wk4", _
FileFormat:=xlWK4, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.DisplayAlerts = True
Next
End If
End Sub
Function last_filename(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
last_filename = t1
End Function


--
anilsolipuram
------------------------------------------------------------------------
anilsolipuram's Profile: http://www.excelforum.com/member.php...o&userid=16271
View this thread: http://www.excelforum.com/showthread...hreadid=379459

open file from folder save in new folder
 

I works great, but there's one thing that I want. at the begining of th
code instead of you choosing the folder and the files in it,you choos
the folder and the program atuomaticly gets all the files that has th
word "detail" in it (like the code did originally), but otherwise i
works great. Thank you for helping me. I really appreciate it

--
tim6
-----------------------------------------------------------------------
tim64's Profile: http://www.excelforum.com/member.php...fo&userid=2329
View this thread: http://www.excelforum.com/showthread.php?threadid=37945

open file from folder save in new folder
 

Back up your workbook before executing this macro.

This is completely different solution, when you execute the macro i
will not popup filedialog , the macro will go to folder specified b
"path" variable and opens files like *detail*.htm, and does samethin
as the previous macro.







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 = "C:\Documents and Settings\Administrator\Desktop\webpages\
'path from which files will be extracted to should end with "\"
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 folde
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 & ".wk4", _
FileFormat:=xlWK4, 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
last_filename = t1
End Functio

--
anilsolipura
-----------------------------------------------------------------------
anilsolipuram's Profile: http://www.excelforum.com/member.php...fo&userid=1627
View this thread: http://www.excelforum.com/showthread.php?threadid=37945

open file from folder save in new folder
 

it does nothing for some reaso

--
tim6
-----------------------------------------------------------------------
tim64's Profile: http://www.excelforum.com/member.php...fo&userid=2329
View this thread: http://www.excelforum.com/showthread.php?threadid=37945

open file from folder save in new folder
 

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 = "C:\Documents and Settings\Administrator\Desktop\webpages\
<-------I don't want it to go there. I want to choose Where it goes
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 wa
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
last_filename = t1
End Functio

--
tim6
-----------------------------------------------------------------------
tim64's Profile: http://www.excelforum.com/member.php...fo&userid=2329
View this thread: http://www.excelforum.com/showthread.php?threadid=37945

open file from folder save in new folder
 

paste your code,

did you change the path variable valu

--
anilsolipura
-----------------------------------------------------------------------
anilsolipuram's Profile: http://www.excelforum.com/member.php...fo&userid=1627
View this thread: http://www.excelforum.com/showthread.php?threadid=37945

open file from folder save in new folder
 

a. do you mean this code
b. no I dont think so

Sub ConvertFiles()
'
'
Application.DisplayAlerts = False

'
Dim vrtSelectedItem As Variant

Dim FileToOpen As String
'Declare a variable as a FileDialog object.
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.Title = "Cool Application"
fd.InitialFileName = "Working"
If fd.Show = -1 Then
For a = 1 To fd.SelectedItems.Count
MsgBox fd.SelectedItems(a)
Dim NextFile As String


NextFile = Dir(fd.SelectedItems(a) & "\*detail*.htm")
Do While NextFile < ""
Workbooks.Open Filename:=NextFile
ActiveWorkbook.SaveAs Filename:= _
NextFile & ".wk4", _
FileFormat:=xlWK4, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Save
ActiveWorkbook.Close
NextFile = Dir()


Loop
Next
End If

Application.DisplayAlerts = True


End Sub


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

open file from folder save in new folder
 

No I mean the code that you tested and it didnot do anythin

--
anilsolipura
-----------------------------------------------------------------------
anilsolipuram's Profile: http://www.excelforum.com/member.php...fo&userid=1627
View this thread: http://www.excelforum.com/showthread.php?threadid=37945

open file from folder save in new folder
 

its on the the post before you say to post it (post #16)


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

open file from folder save in new folder
 

Try this macro now

1) it will popup with filedialog, select the folder where the
detail*.htm files are there, click ok, rest should work same as before

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 & ".wk4", _
FileFormat:=xlWK4, 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


--
anilsolipuram
------------------------------------------------------------------------
anilsolipuram's Profile: http://www.excelforum.com/member.php...o&userid=16271
View this thread: http://www.excelforum.com/showthread...hreadid=379459