Set curdir from where template was opened

[William Hamilton]

I have an app where there is a templete that resides in a directory,
under this directory is a data storage folder, the location of the
template can change. Part of the code builds the require directory
structure below the template location.

Is there a way to set the curdir to where the workbook was opened from
ie: where template sits? I am interupting the save process so I can set
the name of the file depending on values within a worksheet, it needs to
default to the "place where template is"\datastore\"Name I define".xls

TIA

W


Code below FYI:

Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

'error trap
On Error GoTo Etrap

Dim MyCell, mySavePath, mySaveName

MyCell = Range("Summary!B6")
mySavePath = CurDir & "\datastore\"
mySaveName = mySavePath & MyCell
'MsgBox (CurDir & "\datastore\" & MyCell)

' confirm the datastore directory exists, if not create it.
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.folderexists(mySavePath) Then
Else
FSO.createfolder (mySavePath)
End If

'check value of activecell
If MyCell = "0" Then
MsgBox "Please check you have a candidate name", vbInformation
Exit Sub
End If

'ask user to save
'If MsgBox("Save new workbook as " & CurDir & "\datastore\" &
MyCell & ".xls?", vbYesNo) = vbNo Then
'Exit Sub
'End If

'save activeworkbook as new workbook
ActiveWorkbook.SaveAs Filename:=mySaveName & ".xls",
FileFormat:=xlNormal


Etrap:

Beep
Exit Sub

 

[Dave Peterson]

Once the user creates a new workbook based on a template, then any connection to
that template's folder is lost.

Any way you can create a macro that allows the user to pick the template, but
you can monitor from where they opened the template?

kind of:

Option Explicit
Sub openTemplate()

Dim myPath As String
Dim myFileName As Variant

myFileName = Application.GetOpenFilename _
(filefilter:="Template files, *.xlt", _
Title:="Create a New Workbook Based on This Template")

If myFileName = False Then
Exit Sub 'user hit cancel
Else
Workbooks.Add template:=myFileName
End If

myPath = Mid(myFileName, 1, InStrRev97(myFileName, "\") - 1)

MsgBox myPath

End Sub

Function InStrRev97(mystr As Variant, mydelim As String) As Long

Dim i As Long
InStrRev97 = 0
For i = Len(mystr) To 1 Step -1
If Mid(mystr, i, 1) = mydelim Then
InStrRev97 = i
Exit Function
End If
Next i
End Function

====
If you're using xl2k or higher, you can replace instrrev97 with InstrRev. And
dump the function itself. (InstrRev was added in xl2k.)