Save in same folder

[krabople]

Hi, I have some code to save a backup of the workbook. However, for some
reason it automatically saves to My documents every time, whereas I want
it to save into the same folder as the original workbook. The code I
currently have is below. Could anyone tell me what I need to change to
get it to save into the same directory?

Sub SaveWorkbookBackup()
Dim awb As Workbook, BackupFileName As String, i As Integer, OK As
Boolean
If TypeName(ActiveWorkbook) = "Nothing" Then Exit Sub
Set awb = ActiveWorkbook
If awb.Path = "" Then
Application.Dialogs(xlDialogSaveAs).Show
Else
BackupFileName = awb.FullName
i = 0
While InStr(i + 1, BackupFileName, ".") > 0
i = InStr(i + 1, BackupFileName, ".")
Wend
If i > 0 Then BackupFileName = Left(BackupFileName, i - 1)
BackupFileName = "RMT" & Worksheets("Month
lookups").Range("k1") & ".xls"
OK = False
On Error GoTo NotAbleToSave
With awb
Application.StatusBar = "Saving this workbook..."
..Save
Application.StatusBar = "If you are still reading this you
must be really bored..."
..SaveCopyAs BackupFileName
OK = True
End With
End If

NotAbleToSave:
Set awb = Nothing
Application.StatusBar = False
If Not OK Then
MsgBox "Backup Copy Not Saved!", vbExclamation,
ThisWorkbook.Name
End If

End Sub

 

[paul.robinson]

Hi
To save to same folder:
MyDirectory = ActiveWorkbook.Path
ChDir MyDirectory

and do your save.

If you want to go to a sub folder:

MyDirectory = ActiveWorkbook.Path & "\" & "Test Directory"
DirTest = Dir$(MyDirectory, vbDirectory)
If DirTest = "" Then
MkDir MyDirectory
DoEvents 'just make sure it is there
End If
ChDir MyDirectory

and do your save.
It first checks if the folder already exists. If it doesn't then the
folder is created. The DoEvents bit is just there to make sure the
folder exists before the next bit of VBA code runs.

regards
Paul

 

[krabople]

Brilliant, thanks a lot for the help