Speichern unter mittels VBA

Private Sub Workbook_Open()
Const Pfad = "C:\Users\Bruno Sutter\Documents\Erlenacker"
Dim strFile As String
Dim IntI    As Integer
ActiveSheet.Unprotect Password:="bnsk"
With Application.CommandBars(1)
.Controls("&Datei").Controls("&Speichern").Enabled = False
.Controls("&Datei").Controls("Speichern unter...").Enabled = False
End With
With Range("H3")
If .Value  "" Then Exit Sub
If .Value = "" Then .Value = Format(Date, "dd.mm.yyyy")
End With
strFile = "Training" & "_" & (Range("H3").Value)
If Dir(strFile & ".xlsm")  "" Then
ActiveWorkbook.SaveAs (strFile & "_1" & ".xlsm"), FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Else
ActiveWorkbook.SaveAs (strFile & ".xlsm"), FileFormat:=xlOpenXMLWorkbookMacroEnabled,  _
CreateBackup:=False
End If
ActiveSheet.Protect Password:="bnsk"
End SubeSheet.Protect Password:="bnsk"
Das Problem ist, dass irgend etwas beim Pfad nicht korrekt ist, denn die Speicherung erfolgt  _
immer in den Ordner Eigene Dateien (Documents). Wie kriege ich es hin, dass
die Speicherung in den Unterordner Erlenacker erfolgt?
Herzlich Dank und freundliche Grüsse
Bruno Sutter