Home |
Search |
Today's Posts |
#12
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]() 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 |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
open and save an entire folder | Excel Discussion (Misc queries) | |||
can“t change folder when open or save | Excel Discussion (Misc queries) | |||
Need code to save file to new folder, erase from old folder | Excel Discussion (Misc queries) | |||
"Save As" folder -- can I default this to the same folder as origi | Excel Discussion (Misc queries) | |||
I like to open a folder,auto print,save then close | Excel Programming |