LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #12   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default 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

 
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
open and save an entire folder SusanWS Excel Discussion (Misc queries) 1 June 15th 06 03:56 PM
can“t change folder when open or save stian Excel Discussion (Misc queries) 0 April 21st 06 08:07 PM
Need code to save file to new folder, erase from old folder Ron M. Excel Discussion (Misc queries) 1 February 24th 06 06:02 PM
"Save As" folder -- can I default this to the same folder as origi Mike Excel Discussion (Misc queries) 1 June 11th 05 12:06 AM
I like to open a folder,auto print,save then close tied of opening files Excel Programming 2 April 22nd 05 10:20 PM


All times are GMT +1. The time now is 02:07 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"