saving to two places by selecting one (VBA)

T

tim64

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
 
A

anilsolipuram

what do you mean by save to the selected folder and the folder abov
it, what is folder above it mean?, There might be many folders abov
the selected folder, which folder is the exact folder that the fil
need to be saved
 
T

tim64

like the folders root folder. (example) C:\programs\something
................................................................^...................^
................................................................^...................^
......................................................folder abov
it.........^
............................................................................folde
selected


the periods are to keep them in plac
 
A

anilsolipuram

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
 
T

tim64

When I say "folder above it" I mean its root folder.

So I guess what I want is for the program to save tran.wk4 in th
selected folder and that folders root folder. for example, selecte
folder --> "project_test0001" and root folder --> "project_test". Als
for the second part I want the name of the selected folder to be at th
end of the list this code makes
 
A

anilsolipuram

try this macro

Sub macro()
Cells(2, 3).Select
End Sub
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:\")
MsgBox user_pick
r = 1
NEXT_FILE = Dir(user_pick + "\*detail*.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
temp = Split(user_pick, "\")
temp1 = temp(UBound(temp))
temp2 = Split(user_pick, temp1)
ActiveWorkbook.SaveAs Filename:=temp2(0) & "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
 
T

tim64

No, I don't want the name of the folder you choose to be part o
tran.wk4's name. I want the name of the folder you choose to be at th
end of the list IN tran.wk4, but otherwise everything else is good
 
T

tim64

(example)ok say I have a folder named Project_test, and in that folder
have a sub-folder named project_test0007. In project_test0007 there'
five files "detail1.wk4", "detail2.wk4", "detail3.wk4", "detail4.wk4"
and "detail5.wk4". So when I run the program I choose the sub-folde
project_test0007 then the program lists the names of the files i
project_test0007 from A1 to A5, and then after it lists the file name
it lists the sub-folder name "project_test0007" in A6. Then it save
the file, tran.wk4, in the folder Project_test
 
A

anilsolipuram

Try this macro and let me know

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 + "\*detail*.wk4")
Do Until NEXT_FILE = ""
Sheets("Sheet1").Select
Sheets("Sheet1").Cells(r, 1) = NEXT_FILE
NEXT_FILE = Dir()
r = r + 1
Loop
Sheets("Sheet1").Cells(r, 1) = user_pick
temp = Split(user_pick, "\")
temp1 = temp(UBound(temp))
temp2 = Split(user_pick, temp1)
MsgBox temp2(0)
ActiveWorkbook.SaveAs Filename:=temp2(0) & "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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

copying from one file pasting in another 4
fixing code 3
Excel VBA - counting cells by colors and names to it in two different rows. 0
Iterative consolidation macro can't complete - memory overload? 5
Code execution is correct but generates Error :The file you aretrying to open is in a different form 3
Saving a workbook - vba 1
Loop Repeats - PLS HELP 2
Fill down two columns...C & D 4

Top