PDA

View Full Version : Solved: Need help to save file at User selected folder



ianswer
10-03-2011, 11:45 AM
How can I modify this program to save excel file at user selected folder?



Option Explicit

Function BrowseForFolder(Optional OpenAt As Variant) As Variant
'Function purpose: To Browser for a user selected folder.
'If the "OpenAt" path is provided, open the browser at that directory
'NOTE: If invalid, it will open at the Desktop level

Dim ShellApp As Object

'Create a file browser window at the default folder
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, OpenAt)

'Set the folder to that selected. (On error in case cancelled)
On Error Resume Next
BrowseForFolder = ShellApp.self.Path
On Error Goto 0

'Destroy the Shell Application
Set ShellApp = Nothing

'Check for invalid or non-entries and send to the Invalid error
'handler if found
'Valid selections can begin L: (where L is a letter) or
'\\ (as in \\servername\sharename. All others are invalid
Select Case Mid(BrowseForFolder, 2, 1)
Case Is = ":"
If Left(BrowseForFolder, 1) = ":" Then Goto Invalid
Case Is = "\"
If Not Left(BrowseForFolder, 1) = "\" Then Goto Invalid
Case Else
Goto Invalid
End Select

Exit Function

Invalid:
'If it was determined that the selection was invalid, set to False
BrowseForFolder = False

End Function

ianswer
10-03-2011, 12:58 PM
File name is already defined.

I just want to pick the folder name using Shell.application from user's input.

How can above program cut-short?

ianswer
10-03-2011, 01:30 PM
Following were easy one: -



Browse For Folder (using FileDialog method)
'www.vbaexpress.com/kb/getarticle.php?kb_id=896

Allow User to Browse for a Folder
'www.vbaexpress.com/kb/getarticle.php?kb_id=246

mancubus
10-03-2011, 11:02 PM
How can I modify this program to save excel file at user selected folder?



Option Explicit

Function BrowseForFolder(Optional OpenAt As Variant) As Variant
'Function purpose: To Browser for a user selected folder.
'If the "OpenAt" path is provided, open the browser at that directory
'NOTE: If invalid, it will open at the Desktop level

Dim ShellApp As Object

'Create a file browser window at the default folder
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, OpenAt)

'Set the folder to that selected. (On error in case cancelled)
On Error Resume Next
BrowseForFolder = ShellApp.self.Path
On Error Goto 0

'Destroy the Shell Application
Set ShellApp = Nothing

'Check for invalid or non-entries and send to the Invalid error
'handler if found
'Valid selections can begin L: (where L is a letter) or
'\\ (as in \\servername\sharename. All others are invalid
Select Case Mid(BrowseForFolder, 2, 1)
Case Is = ":"
If Left(BrowseForFolder, 1) = ":" Then Goto Invalid
Case Is = "\"
If Not Left(BrowseForFolder, 1) = "\" Then Goto Invalid
Case Else
Goto Invalid
End Select

Exit Function

Invalid:
'If it was determined that the selection was invalid, set to False
BrowseForFolder = False

End Function



hi ianswer

this code is from http://www.vbaexpress.com/kb/getarticle.php?kb_id=284
and the file provided in the article contains examples...

here is one:

Sub test1()
Dim result As String
result = BrowseForFolder
Select Case result
Case Is = False
result = "an invalid folder!"
Case Else
'don't change anything
End Select
MsgBox "You selected " & result, _
vbOKOnly + vbInformation
End Sub



you may adopt this to save a file.

Sub savefile()
Dim fFolder As String, fName As String
fName = "MyFile"
fFolder = BrowseForFolder
Select Case fFolder
Case Is = False
fFolder = "an invalid folder!"
Case Else
fName = fFolder & "\" & fName
End Select
ActiveWorkbook.SaveAs fName, 52 '52=xlsm, 51=xlsx, 50=xlsb, 56=xls
End Sub

ianswer
10-04-2011, 12:14 PM
I have comparatively easy one, but It didn't work.
Can you please help me to modify it so that it can save file at some folder?


Sub saveatfolder(myfilename As String)

With Application.FileDialog(msoFileDialogFolderPicker)
.Show
folderlocation = .SelectedItems(1)
myfilepath = folderlocation & "\" & myfilename
End With

ActiveWorkbook.SaveAs Filename = myfilepath, FileFormat = xlWorkbookNormal
End Sub

Private Sub testsave()
ThisWorkbook.saveatfolder "Got"
End Sub

mancubus
10-04-2011, 02:59 PM
it works for me...

btw...

Private Sub testsave()
Dim wb As Workbook
Call saveatfolder("Got")
End Sub


Sub saveatfolder(myfilename As String)
Dim wb As Workbook

With Application.FileDialog(msoFileDialogFolderPicker)
.Show
folderlocation = .SelectedItems(1)
End With

myfilepath = folderlocation & "\" & myfilename
If wb Is Nothing Then Set wb = ActiveWorkbook
wb.SaveAs Filename:=myfilepath, FileFormat:=xlWorkbookNormal

End Sub

ianswer
10-05-2011, 01:04 AM
Thanks, it worked.

mancubus
10-05-2011, 01:22 AM
wellcome.

pls mark the the thread as "SOLVED" from thread tools...