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


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