Solved

Button on sheet to set a folder destination to save a file too

Posted on 2014-09-10
37
118 Views
Last Modified: 2014-09-25
The code below saves a file for me, but the problem with it is that not everyone has the same destination folder as I do.  Is there a way to change this so a user can have a button on a sheet that sets the destination folder for them?  This way the user can point to where they want it saved.

Sub Save_SIF()
    Dim strFilePath, strFileName As String
    
    strFilePath = "C:\_SAP\GSA Extracts\GSA_SifFiles\" 'This needs to be changed to correct directory and must end with \
    
    strFileName = InputBox("Please enter a filename or click OK to accept the default.", "Save File", _
                "TestFile-" & Format(Now(), "yyyy-mm-dd")) '<--- change to new default

    If strFileName = "" Then
        Sheets("SIF Data").Select
        ActiveWindow.SelectedSheets.Visible = False
        Sheets("Order Line Items").Select
        ActiveWindow.SelectedSheets.Visible = False
        Exit Sub 'Will happen if Cancel is pressed
    End If
    strFileName = strFileName & ".sif"
    
    Application.DisplayAlerts = False
    ActiveSheet.Copy
    
    ActiveWorkbook.SaveAs Filename:= _
        strFilePath & strFileName, FileFormat:=xlTextPrinter, CreateBackup:=False
    ActiveWorkbook.Close savechanges:=False
    
    Application.DisplayAlerts = True
'    MsgBox "Sif file saved"
End Sub

Open in new window

0
Comment
Question by:RWayneH
  • 18
  • 18
37 Comments
 
LVL 21

Expert Comment

by:mcsween
Comment Utility
This will pull the directory from cell A1 on the worksheet named FILEPATH and check to make sure it has a trailing backslash.
strFilePath = Worksheets("FILEPATH").Cells(A, 1).Value
If Right(STRFilePath,1) <> "\" Then
	strFilePath = strFilePath & "\"
End If

Open in new window

0
 
LVL 29

Expert Comment

by:gowflow
Comment Utility
This is a modified version of your macro that will prompt the user to choose a folder to save file to. By default it will point to your preset folder which is:
"C:\_SAP\GSA Extracts\GSA_SifFiles\"

if it does not find it will will open the Document folder of the user. He can then scroll or choose any folder he wishes to save file to and by pressing OK it will save the file to it as you preset it:
"TestFile-" & Format(Now(), "yyyy-mm-dd"))

I have suppressed the choice of changing the filename. If you still need the user to choose or alter the file name then we can reinstate it.

Let me know here is the code amended.

Sub Save_SIF()
    Dim strFilePath As String, strFileName As String
    Dim vrtSelectedItem As Variant
    
    strFilePath = "C:\_SAP\GSA Extracts\GSA_SifFiles\" 'This needs to be changed to correct directory and must end with \

    'strFileName = InputBox("Please enter a filename or click OK to accept the default.", "Save File", _
                "TestFile-" & Format(Now(), "yyyy-mm-dd")) '<--- change to new default

    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = strFilePath
        .Title = "Please enter Folder destination."
        .Show
        
        For Each vrtSelectedItem In .SelectedItems
            strFileName = vrtSelectedItem & "\" & "TestFile-" & Format(Now(), "yyyy-mm-dd")
        Next
    End With
    
    
    If strFileName = "" Then
        Sheets("SIF Data").Select
        ActiveWindow.SelectedSheets.Visible = False
        Sheets("Order Line Items").Select
        ActiveWindow.SelectedSheets.Visible = False
        Exit Sub 'Will happen if Cancel is pressed
    End If
    strFileName = strFileName & ".sif"
    
    Application.DisplayAlerts = False
    ActiveSheet.Copy
    
    ActiveWorkbook.SaveAs Filename:= _
        strFileName, FileFormat:=xlTextPrinter, CreateBackup:=False
    ActiveWorkbook.Close savechanges:=False
    
    'ActiveWorkbook.SaveAs Filename:= _
        strFilePath & strFileName, FileFormat:=xlTextPrinter, CreateBackup:=False
    ActiveWorkbook.Close savechanges:=False
    
    Application.DisplayAlerts = True
'    MsgBox "Sif file saved"
End Sub

Open in new window



gowflow
0
 

Author Comment

by:RWayneH
Comment Utility
I am not sure how to implement this...  the idea is that there is a button on a sheet tab.    "..." and the user clicks on it once and sets the folder so it saves the file there each time.  Perhaps having the it show in a cell after the selection is made, would be nice, so as a user may change it from time to time, depending on the project/need.

What I have problems with is modifying this to do this.  I can create a button, but placing the result in a cell and setting it to be used every time until the button is used again.  Asking the user to select every time or enter through another dialog box is not the answer...  the save file sub is used way too many time to do that.

Hope this make sense.
0
 
LVL 29

Expert Comment

by:gowflow
Comment Utility
Did you check my solution ?
gowflow
0
 

Author Comment

by:RWayneH
Comment Utility
Yes, but there some things that we would.  We want a more visible option, so the user knows where it is going prior to running any of the subs that use it.  In the header of a sheet tab/page, we would like a physical button that sets the folder and is labeled, "Select .sif file save location" with the result of that output in a cell close to the button.  This way they know already were the files are going.

Another issue is 99% of the time we are renaming the file to a unique name, so we will have to be able to chg the filename.  (we create 20-30 of these a day).  We then use them to upload to another system.

Your solution is nice and has uses, but for what we need for this one, we need a physical button on a sheet tab to set the folder location and just that...  Then we need to modify the procedure to use whatever was set.

Is this possible?
0
 
LVL 29

Expert Comment

by:gowflow
Comment Utility
Got it !
I usually do it the way you are requesting it but thought it was an overkill for you reason why I simply modified your code. I need to step out and will draft all this and send it to you when I reach destination. Could you attach a workbook that have some of your data and this original code so I can propose something that is catered to you as we also need to modify you SAVE original sub to refer to the button to get the folder.

Will wait for your file and comments if any.
gowflow
0
 

Author Comment

by:RWayneH
Comment Utility
File is attached.  I stripped it down and removed a lot, but for the purposes of this I left what was needed.  Please comment the codes as best you can with the adds you make.

The original had over 524K rows, and we would create a bunch of .sif files to upload to another system that could not handle files with certain amount of data.

I place the active cell in column C, and press the create buttons.  Of course you need to select a range in column C if you use the CreateFromSelection button....

Hope this makes sense and thanks for the help.
SampleButtonFile.xlsm
0
 
LVL 29

Expert Comment

by:gowflow
Comment Utility
I see you have created a button ** NEW ** Set File Save Location
but this button is already linked to a macro
MakeSIF_FromSelected

What is your idea ???

In my mind if I understood your requirement correctly We would have a button that when it is clicked it opens for you a folder lookup and you choose a folder where you want the macro to pull data from and once you click ok then it will display the folder path under this button.

Each time you click on this button you will be able to alter this folder path and as long as it is there any time you activate your main macro SAVE then it will save to produced files under this folder.

So my question for you:
Is this what you want ? if yes then I will need to create an other button than the one you already have is that ok with you ? If yes then you need to explain what do you mean by selecting cells ??? this was not the purpose of this question if I understood well you needed a button to set a folder

Right ?
gowflow
0
 

Author Comment

by:RWayneH
Comment Utility
Sorry I copied a button and just placed it there.  It should not have been assigned to anything.  When clicking this new button, it will set where the file is going to be saved.  That is it.  Then inside the other create buttons (where the file is currently saved), we had to tie the location (from the new button) to the save process (Save_SIF()  ), that is in the create buttons.   I call to the Save SIF()  at the end of the insert_mktg_prog()  sub, which is in each of the create buttons.

You may have to read this a few times, but the Save part is already done.  All this new button needs to do is set the save location that the Save SIF() can use.
0
 
LVL 29

Expert Comment

by:gowflow
Comment Utility
ok let me look at all this.
Will revert.
gowflow
0
 
LVL 29

Accepted Solution

by:
gowflow earned 500 total points
Comment Utility
ok here it is:

I have created a new module Called: SetDestinationFolder in which I have put the following code:

Global Const APP_CATEGORY = "Software JG"
Global Const APPNAME = "ExportFiles"
Global gstDestinationFolder As String

Function GetNewFolder(ByVal fFolder As String, Title As String)

fFolder = GFolderName(Title)

If fFolder <> "" And Dir(fFolder, vbDirectory) <> "" Then
    GetNewFolder = fFolder
Else
    MsgBox ("No Folder has been selected or the Folder does not exist, therefore data cannot be Exported" _
        & " until valid Folder has been selected." & Chr(10) & Chr(10) _
        & "Please press on the command bar to choose a Folder.")
    GetNewFolder = "Browse"

    With Application
        .DisplayAlerts = True
        .EnableEvents = True
    End With
    
    Exit Function
End If
End Function

Function GFolderName(fol As String) As String
Dim vrtSelectedItem

With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = gstDestinationFolder
    .InitialFileName = ""
    .Title = "Please choose Folder location for: " & fol
    .InitialView = msoFileDialogViewDetails
    .Show

    
    For Each vrtSelectedItem In .SelectedItems
    GFolderName = vrtSelectedItem & "\"
    Next vrtSelectedItem
End With

Set vrtSelectedItem = Nothing

End Function

Open in new window


And I also introduced in Thisworkbook open and Deactivate subs the following code:

Private Sub Workbook_Deactivate()
If gstDestinationFolder <> "" Then SaveSetting APP_CATEGORY, APPNAME, "DestinationFolder", gstDestinationFolder

End Sub

Private Sub Workbook_Open()
gstDestinationFolder = GetSetting(APP_CATEGORY, APPNAME, "DestinationFolder", vbNullString)

End Sub

Open in new window


I created on sheet MasterCopy a button and it have following code:

Private Sub CommandButton1_Click()
gstDestinationFolder = GetNewFolder(gstDestinationFolder, "Destination Folder")
If gstDestinationFolder <> "Browse" Then
    Sheets("MasterCopy").CommandButton1.Caption = "Target Export Folder: <" & gstDestinationFolder & "> ... Activated"
Else
    Sheets("MasterCopy").CommandButton1.Caption = gstDestinationFolder
End If
End Sub

Open in new window


Basically the way it works is by default the button has browse in it  meaning you need to select a destination folder if it is not selected and it shows Browse then when you launch the sub called SAVE SIF it will halt telling you that you need to choose a destination folder first. when you select a folder a popup will display folder and you can navigate to the folder you want once selected it will display inn the button as Activated and when the SAVE SIF is launched it will pickup this folder name.

Anytime you save and close the workbook it will save the last registered folder in your registry so that next time when you open it will remember it and display it again so you don't need to choose the folder each and every time you launch it.

I did not test it as you refer to folders I do not have in my pc pls test it and let me know if all ok.

All this code is in the workbook attached.
gowflow
SampleButtonFile-V01.xlsm
0
 

Author Comment

by:RWayneH
Comment Utility
Ok I copied in the module into my workbook, copy and pasted the button, and then copy and pasted the Workbook_Open and other destination subs.

When I close and reopen the workbook it is error'ing on Workbook_Open
Invalid procedure call or argument

Everything else seems to be working ok.  Any ideas why it fails each time the workbook would open?  It is working ok in you sample file...  Try to implement this in the original workbook now and it is not liking the Workbook_Open sub?
0
 

Author Comment

by:RWayneH
Comment Utility
Further testing, after copying the code into my master file, the create button are still saving to the hard coded folder path.  Would there have to be some sort of edit the the Save_SIF sub?  It should be in sample file that I attached.  Reviewing you solution file for clues.
0
 

Author Comment

by:RWayneH
Comment Utility
I should probably clarify, the Create SIF buttons, are still saving the file to the location in the Save_SIF sub
0
 
LVL 29

Expert Comment

by:gowflow
Comment Utility
ok always transferring part of code need special care. follow these steps:

1) Take your latest 'working workbbok' like the one that had all the code prior to creating this question. Like it should have your uptodate data and all the code EXCLUDING the one I send you here.
2) Make a copy of this workbook and give it a new name (so we don't work on your production file but rather on a copy. When all is ok then you will use this new workbook as you production final workbook.
3) open the file we just created.
4) Open the file I attached that contain the solution SampleButtonFile-V01.xlsm
5) Press on the Developper table and choose Visual basic
6) on the left pane if you look well you will see the 2 files in bold and under each the corresponding sheets. Make sure it is clear for you which one is your production and which one is the solution and keep in mind we will always COPY from solution and paste into production.
7) first thing to do is to copy the new module created to do this simply drag the module SetFolderDestination to your production file under module and it will create it there.
8) Make sure you are now in your production and press SAVE
9) We will copy what is in ThisWorkbook double click on Thisworkbook that is in the Solution file select all the data that is shown press Copy then doubleclick on your production file in Thisworkbook and paste the data there.
10) again here press SAVE in your production file.
11) Now we will need to create the button in the sheet MasterCopy for this your will need (if I remember well to delete the button that you had created already as if was linked to a macro and it is a different button than the one I used) so make sure that in your production workbook there are only the 3 grey buttons and not 4.
12) Now we need to delete the code that you have already previously created in your production workbook. So doubleclick in the left pane in your production workbook on the sheet MasterCopy and you will find code for CommandButton1 and CommandButton2 you need to delete all this code.
13) goto the solution file in sheet MasterCopy and right click on the green button and copy then goto your production file go to sheet MasterCopy and paste the button there.
14) once the button is created doubleclick on it to see if it copied the code with it. If it did not you will need to display all the code that is under commanbutton1 in the solution and copy it in your production under commandbutton1.
14) SAVE the production workbook and exit. close the solution without saving it.
15) Start the production workbook and give it a try.

Let me know.
gowflow
0
 
LVL 29

Expert Comment

by:gowflow
Comment Utility
I should add to above that you should replace your initial SAVE SIF by the new one in the solution file.
gowflow
0
 

Author Comment

by:RWayneH
Comment Utility
Mine is failing on the after replacing the Save_SIF sub from your Sample to the master file.
    ActiveWorkbook.SaveAs Filename:= _
        strFilePath & strFileName, FileFormat:=xlTextPrinter, CreateBackup:=False

Any ideas on why the Workbook_Open would be failing everytime the file is opened?
0
 
LVL 29

Expert Comment

by:gowflow
Comment Utility
You are mentioning 2 issues here:

1) Are you getting an error at this line ?
    ActiveWorkbook.SaveAs Filename:= _
         strFilePath & strFileName, FileFormat:=xlTextPrinter, CreateBackup:=False
if yes then what does the error say ?

2) What do you mean by workbook_Open failing what do you get what type of error ???

Cannot troubleshoot if I am not getting the error

Did you follow the steps I advised before ?
gowflow
0
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 

Author Comment

by:RWayneH
Comment Utility
The file save is failing in the sample file you provided too.
0
 
LVL 29

Expert Comment

by:gowflow
Comment Utility
GIVE ME THE ERROR PLEASE !!!
when you get the error do a print screen and attach the picture if you cannot tell me what the system says.
gowflow
0
 

Author Comment

by:RWayneH
Comment Utility
the file save error is: Cannot access read-only document 'TestCreateOnSelection.sif'
the document is the name I give it.
0
 

Author Comment

by:RWayneH
Comment Utility
For some reason the Workbook_Open is not failing anymore??  Could that fail because I did not have the Save_SIF edit done?  That does not appear to be an issue anymore...  just the SaveAs issue with a read-only.
0
 
LVL 29

Expert Comment

by:gowflow
Comment Utility
don't know what you did or did not do. I know that you have a long workbook that have lots of cade and working with it should be careful.

You need to close all workbooks then open your macro and then run it if you have other workbooks opened you may hv some issues as some of them could be opened by macro and hv conflicting info.

Let me know if all is ok.
gowflow
0
 

Author Comment

by:RWayneH
Comment Utility
Ok... testing is going much better....  not sure what the read-only was all about...  Also the Workbook_Open corrected itself??   Was there a sequence to implement this?  I think the only thing I forgot was to replace the Save_SIF sub.  Could that have messed a lot up?  It seems that after I replaced that, close and reopened the file, started chg'ing destination folder etc.  The testing started to work.   Still testing..
0
 
LVL 29

Expert Comment

by:gowflow
Comment Utility
ok fine glad we are at a better stage.
Let me know your findings.
gowflow
0
 

Author Comment

by:RWayneH
Comment Utility
Ok testing has proven stable and it is working.  Excellent!!!  One thing that I have noticed is that if different people use the file, each one may or may not have the same target location.  This could produce a problem.  Is it difficult to check and see if the target exists in the Workbook_Open?  If not, display that "Browse" if it does display whatever the target is?  This way it forces the edit prior to any Create.  And if a create is clicked, maybe kick it out, prior to the InputBox, saying a target has yet to be set... please set a destination folder then create.

Just some thoughts.  I will be using this on a number of solutions that save out files to a specified folder.  THANK YOU!! for such an awesome solution!!
0
 
LVL 29

Expert Comment

by:gowflow
Comment Utility
ok I hear what you say. You are correct when you use a same version of the file over the network the way it was designed was missing a refresh only upon opening as it relies on the user's registry and this is where it gets its folder location from as last time saved.

So please do the following:
1) Take a copy of your current production workbook
2) Open it and do not activate macros.
3) Goto VBA and doubleclick on Thisworkbook
4) Display the Sub Workbook_Open

5) Make sure that the new code is the following:

Private Sub Workbook_Open()
gstDestinationFolder = GetSetting(APP_CATEGORY, APPNAME, "DestinationFolder", vbNullString)
If gstDestinationFolder <> "" And gstDestinationFolder <> "Browse" Then
    Sheets("MasterCopy").CommandButton1.Caption = "Target Export Folder: <" & gstDestinationFolder & "> ... Activated"
Else
    Sheets("MasterCopy").CommandButton1.Caption = "Browse"
End If
End Sub

Open in new window


6) SAVE the workbook.
7) Try the new version live

NOTE:
What this will do is for instance you open last the file and pointed to folder H:\ABC and worked on it and saved the file. The button shows for the next user opening it H:\ABC. Now this new person had already used this file and it had in his registry the location I:\Main\Display so once the file is opened by the new user it will recall this new location from his own registry and automatically update the button to show I:\Main\Display as it was a location already saved by him hence active for him and this without any intervention from his part nor even him noticing that it was last showing H:\ABC

The way it was designed before this change was fine as it assumes only 1 user working on the file so no problem but now you mentioned network then obviously this change must be performed to cater for this.

Let me know.
gowflow
0
 

Author Comment

by:RWayneH
Comment Utility
Ok, got it working and thanks.  What is up with the CommandButton text getting smaller each time it is clicked on?  I have been increasing the font and am running out to sizes...  that is odd.
0
 
LVL 29

Expert Comment

by:gowflow
Comment Utility
Weird I don't hv this problem what version of Excel are you running ?
gowflow
0
 

Author Comment

by:RWayneH
Comment Utility
Excel 2007 (12.06683.5002) SP3 MSO (12.0.6683.5000)
0
 
LVL 29

Expert Comment

by:gowflow
Comment Utility
I tried in 2007 nd 2010 and cannot reproduce the problem. Can you post a sample pic of what is happeneing or explain more in detail what is happening and when
gowflow
0
 
LVL 29

Expert Comment

by:gowflow
Comment Utility
did you change the button ?  it is an activeX button the one you select from the list as in the pic

commandButton
gowflow
0
 

Author Comment

by:RWayneH
Comment Utility
No I did not change a thing.  I am watching it as I test and use it..  It does not appear to be doing it anymore or as often..  we may be ok with it.  Going to give it another day or so...  Testing going very well.   Believe you nailed it...  Great solution!
0
 
LVL 29

Expert Comment

by:gowflow
Comment Utility
ok great. Regarding the font issue I know that listboxes have a property called IntegralHeight and by default it is set to True and what it does is that the listbox automatically expands to fit the text that is in the list so you have a behavior of a listbox that changes in dimension which is sometimes annoying. So putting this property to False prevent the listbox from changing. I did not see this property in the CommandButton so do not understand why it would change font unless maybe if your using a non standard font could this be the problem ?
gowflow
0
 

Author Comment

by:RWayneH
Comment Utility
Not seeing the font issue much...  it is not happening like to was.  Testing has produced and great solution with the Button.  Thanks.  The font issue would be a separate question, if it start doing it again.
0
 

Author Closing Comment

by:RWayneH
Comment Utility
This solution along with the Workbook_Open edit to check for the folder, works great.  THANKS!!
0
 
LVL 29

Expert Comment

by:gowflow
Comment Utility
Your welcome. Glad I could help
gowflow
0

Featured Post

Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

Join & Write a Comment

Drop Down List with Unique/Distinct Values (Part II - ComboBox or ListBox and Data Validation List Bonus!) David Miller (dlmille) Intro This article focuses on delivering unique, sorted lists to list objects (e.g., ComboBox, ListBox) and Dat…
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

763 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

6 Experts available now in Live!

Get 1:1 Help Now