Setting Directory when Saving File
 

This code works fine, except that when the Save As window opens, it goes to
the My Documents directory, not the directory where the file is located
(which is what I want). Each week, the users open a Master file with default
information and then saves the weekly file with a specified file name. The
problem is, the directory is wrong.
I've tried several ways of establishing the directory path and inserting
into the code with no luck. This is part of a userform macro.
The path name may change, so the macro MUST open to the path where the
current file is located. Ex: C:\My Documents\Weekly Files\/
Here is the code that creates and saves the file:

Private Sub CommandButton2_Click()
Dim password As String

Unload Me

Application.ScreenUpdating = False

With Worksheets("global setup")
Worksheets("Global Setup").Select
Range("CA3").Select
password = Range("CA3").Value
Application.ThisWorkbook.Unprotect (password)
ActiveSheet.Unprotect (password)
With .Range("e5")
.Value = CDate(Me.ComboBox2.Value)
.NumberFormat = "mm-dd-yy"
End With

Application.ScreenUpdating = True

Worksheets("Global Setup").Select
Worksheets("Global Setup").Rows("13").Hidden = True
Range("L5").Select
ActiveSheet.Protect (password)
Application.ThisWorkbook.Protect (password), structu=True
End With

'SaveWeeklyFile()
'
'
Dim FName As String

With ActiveWorkbook.Worksheets("Global Setup")
FName = "BP-" & .Range("E4").Value & "(" & .Range("E3").Value & ")" _
& Format(.Range("E5").Value, "-mm-dd-yyyy") & ".xls"
End With

Dim myFileName As Variant
Dim OkToSave As Boolean
Dim resp As Long

Application.ScreenUpdating = False

Worksheets("Global Setup").Select
Range("CA3").Select
password = Range("CA3").Value
Range("L5").Select

Worksheets("Team Scorecard").Activate

Application.ThisWorkbook.Unprotect (password)
ActiveSheet.Unprotect (password)

Application.ScreenUpdating = True

Range("A1").Select

ActiveSheet.Protect (password)
Application.ThisWorkbook.Protect (password), structu=True

Do
myFileName = Application.GetSaveAsFilename(FName)
'fileFilter:="Excel Files (*.xls), *.xls")
If myFileName = False Then
Exit Sub
End If

OkToSave = True
If Dir(myFileName) = "" Then
'do nothing special
Else
resp = MsgBox(prompt:="Overwrite Existing file?", _
Buttons:=vbYesNoCancel)
Select Case resp
Case Is = vbCancel
MsgBox "Try Again Later"
Exit Sub
Case Is = vbNo
OkToSave = False
End Select
End If

If OkToSave Then

Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=myFileName, _
FileFormat:=xlWorkbookNormal
Application.DisplayAlerts = True
Exit Do
End If
Loop

End Sub

Setting Directory when Saving File
 

I got it...thanks!
Used
Dim sPath As String
sPath = ThisWorkBook.Path

ChDir = sPath (Was using CurDir instead of ChDir)!!

"David" wrote:

This code works fine, except that when the Save As window opens, it goes to
the My Documents directory, not the directory where the file is located
(which is what I want). Each week, the users open a Master file with default
information and then saves the weekly file with a specified file name. The
problem is, the directory is wrong.
I've tried several ways of establishing the directory path and inserting
into the code with no luck. This is part of a userform macro.
The path name may change, so the macro MUST open to the path where the
current file is located. Ex: C:\My Documents\Weekly Files\/
Here is the code that creates and saves the file:

Private Sub CommandButton2_Click()
Dim password As String

Unload Me

Application.ScreenUpdating = False

With Worksheets("global setup")
Worksheets("Global Setup").Select
Range("CA3").Select
password = Range("CA3").Value
Application.ThisWorkbook.Unprotect (password)
ActiveSheet.Unprotect (password)
With .Range("e5")
.Value = CDate(Me.ComboBox2.Value)
.NumberFormat = "mm-dd-yy"
End With

Application.ScreenUpdating = True

Worksheets("Global Setup").Select
Worksheets("Global Setup").Rows("13").Hidden = True
Range("L5").Select
ActiveSheet.Protect (password)
Application.ThisWorkbook.Protect (password), structu=True
End With

'SaveWeeklyFile()
'
'
Dim FName As String

With ActiveWorkbook.Worksheets("Global Setup")
FName = "BP-" & .Range("E4").Value & "(" & .Range("E3").Value & ")" _
& Format(.Range("E5").Value, "-mm-dd-yyyy") & ".xls"
End With

Dim myFileName As Variant
Dim OkToSave As Boolean
Dim resp As Long

Application.ScreenUpdating = False

Worksheets("Global Setup").Select
Range("CA3").Select
password = Range("CA3").Value
Range("L5").Select

Worksheets("Team Scorecard").Activate

Application.ThisWorkbook.Unprotect (password)
ActiveSheet.Unprotect (password)

Application.ScreenUpdating = True

Range("A1").Select

ActiveSheet.Protect (password)
Application.ThisWorkbook.Protect (password), structu=True

Do
myFileName = Application.GetSaveAsFilename(FName)
'fileFilter:="Excel Files (*.xls), *.xls")
If myFileName = False Then
Exit Sub
End If

OkToSave = True
If Dir(myFileName) = "" Then
'do nothing special
Else
resp = MsgBox(prompt:="Overwrite Existing file?", _
Buttons:=vbYesNoCancel)
Select Case resp
Case Is = vbCancel
MsgBox "Try Again Later"
Exit Sub
Case Is = vbNo
OkToSave = False
End Select
End If

If OkToSave Then

Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=myFileName, _
FileFormat:=xlWorkbookNormal
Application.DisplayAlerts = True
Exit Do
End If
Loop

End Sub