This code would save in selected folder, but I am not clear about 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:\")
r = 1
NEXT_FILE = Dir(user_pick + "\*p*.wk4")
Do Until NEXT_FILE = ""
Sheets("Sheet1").Select
Sheets("Sheet1").Cells(r, 1) = NEXT_FILE
NEXT_FILE = Dir()
r = r + 1
Loop
ActiveWorkbook.SaveAs Filename:=user_pick & "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


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