saving to two folders by selecting one
Hi, I have this code that lists some things and then it saves it in a
user selected folder, and I want to save to the selected folder and the folder above it. Also, I want after it lists the things it lists then it rights the name of the "selected" folder you save it in, but not the folder above it. Sub fill_file_names() Dim user_pick As String Dim r As Integer Application.DisplayAlerts = False Workbooks.Add Range("1:1").Select Range(Selection, Selection.End(xlDown)).Select Selection.ClearContents Range("1:1").Select user_pick = PickFolder("C:\") + "\*detail*.wk4" r = 1 next_file = Dir(user_pick) Do Until next_file = "" Sheets("Sheet1").Select Sheets("sheet1").Cells(r, 1) = next_file next_file = Dir() r = r + 1 Loop ActiveWorkbook.SaveAs Filename:="tran.wk4", FileFormat:=xlWK4, _ CreateBackup:=False ActiveWorkbook.Save ActiveWorkbook.Close Application.DisplayAlerts = True End Sub 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 |
All times are GMT +1. The time now is 10:48 AM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com