Code to browse

[Teeboy]

I have borrowed some code from the board which i have slightly changed to suit my needs. It basically saves the file updating the version number each time and also includes a cell value and the date.

Only problem is it would be better for me if the path could be chosen using browse. Reason being that the file is used by a lot of people with different systems and currently the path is specified in the code.

Private Sub SaveFile_Click()
Dim sFileName, tFilename As String, sPath As String
sPath = "C:\Test_Files\"
tFilename = Range("b8")
sFileName = Format(Now(), "ddmmmyy")

Num = 1
Do While Dir(sPath & tFilename & sFileName & ".xls") <> ""
sFileName = Format(Now(), "ddmmmyy")
Num = Num + 1
VerNum = "_Ver" & Num
sFileName = sFileName & VerNum
Loop

ActiveWorkbook.SaveAs (sPath & tFilename & sFileName)
SaveFile.Enabled = False
End Sub
Cheers

 

[Tazguy37]

You could use the built-in Save As... dialog box:

Application.Dialogs(xlDialogSaveAs).Show

Hope that helps!

 

[tactps]

Or try changing:
sPath = "C:\Test_Files\"
with
sPath = Inputbox("Please specify the exact path required.")

You wuld probably want to add in an error handler to ensure that the path exists.

 

[erik.van.geit]

tactps,

why would you do this with an inputbox, when you could do it with some "clicks" ?
just curious

kind regards,
Erik

 

[Teeboy]

The input box would work for me but i have to assume that the people using the file (which is input only) would not have a clue.

The application.Dialogue works upto a point. although the file does save as a new file, ie the code works. You are prompted to overwrite the existing file which would scare the user. any more ideas?

Thanks

 

[Joe Was]

Run this from a standard module, like: Module1.
The code runs from "BrowseDir." Note: "mySaveFile" is called by the "BrowseDir" Sub!

Option Explicit
Dim FileTitle As String

Sub BrowseDir()
'Display Folder Shell.
Dim objFolder As Object, strFullPath As String, strFileName As String
Dim ws As Worksheet, wb As Workbook
Dim x As Double
'Selects the Current Folder!
Set objFolder = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please Select Folder", 0, Left(CurDir, 3))
'Folder?
If Not objFolder Is Nothing Then
'Root Dir?
If Len(objFolder.Items.Item.Path) > 3 Then
strFullPath = objFolder.Items.Item.Path & Application.PathSeparator
Else
strFullPath = objFolder.Items.Item.Path
End If
End If
'Hold Folder!
FileTitle = strFullPath

'Run the Save File Macro!
mySaveFile

Reset:

Application.DisplayAlerts = True
Application.ScreenUpdating = True
Exit Sub

ErrH:

MsgBox Err.Number & vbCr & _
Err.Description & vbCr _
, vbMsgBoxHelpButton _
, "Error Accessing: " & strFullPath & strFileName _
, Err.HelpFile _
, Err.HelpContext

End Sub

Sub mySaveFile()
Dim sFileName, tFilename As String, Num As Integer, VerNum As String

tFilename = Range("b8")
sFileName = Format(Now(), "ddmmmyy")

Num = 1
Do While Dir(FileTitle & tFilename & sFileName & ".xls") <> ""
sFileName = Format(Now(), "ddmmmyy")
Num = Num + 1
VerNum = "_Ver" & Num
sFileName = sFileName & VerNum
Loop

ActiveWorkbook.SaveAs (FileTitle & tFilename & sFileName)
End Sub

 

[Teeboy]

WOW!

Works perfectly

Cheers.....