Reference active worksheet from macro in personal.xls

[livetohike]

Well I just thought I was so clever as a non-programmer spending two
days writing this macro to save the current worksheet to two different
locations BUT ...

It worked fine in the workbook I wrote it in, then I learned that if I
put it in personal.xls all my workbooks could use it. I managed that
but now it backs up personal.xls not the workbook I execute it from.

I assume there is some way to reference the current workbook from a
macro living within personal.xls?

Also I suspect that there is a much better way to do this than doing
three saves?
Thanks
-----------------------
Sub CopyToTwoLocations()

Dim strFileA As String
Dim strFileB As String
Dim strFileC As String

'Save first just to be safe
ThisWorkbook.Save

'Save the name of the current doc
strFileA = ThisWorkbook.Name

'Capture the name of the current doc before the 'SveAs' changes it
strFileC = ThisWorkbook.FullName

'Define backup paths
strFileB = "C:\My Documents\SaveToTwoLocations\" & strFileA
strFileB2 = "H:\SaveToTwoLocations\" & strFileA

'Save backups
Application.DisplayAlerts = False ' Avoid msg for overwites
ThisWorkbook.SaveAs Filename:=strFileB

On Error GoTo MyError 'In case back up drive is off-line
ThisWorkbook.SaveAs Filename:=strFileB2

'Set the current (active) doc back to the original
ThisWorkbook.SaveAs Filename:=strFileC
Application.DisplayAlerts = True
Exit Sub

MyError:
MsgBox "Backup to flash apparently failed"
ThisWorkbook.SaveAs Filename:=strFileC
Application.DisplayAlerts = True
End Sub

 

[Dave Peterson]

ThisWorkbook is the workbook that owns the code--not the active workbook.

So when you moved the code into your personal.xls workbook, ThisWorkbook became
Personal.xls.

So try changing each occurence of ThisWorkbook to ActiveWorkbook:
strFileA = ThisWorkbook.Name
becomes
strFileA = ActiveWorkbook.Name

And excel's VBA has another way to save a backup. Then you don't have to do
that last .SaveAs to get back to the name you started with. (Check VBAs help
for .savecopyas.)

Option Explicit
Sub CopyToTwoLocations()

Dim strFileA As String
Dim strFileB As String
Dim strFileB2 As String

If ActiveWorkbook.Path = "" Then
MsgBox "Please save this workbook first!"
Exit Sub
End If

'Save first just to be safe
ActiveWorkbook.Save

'Save the name of the current doc
strFileA = ActiveWorkbook.Name

'Define backup paths
strFileB = "C:\My Documents\SaveToTwoLocations\" & strFileA
strFileB2 = "H:\SaveToTwoLocations\" & strFileA

'Save backups
On Error Resume Next
ActiveWorkbook.SaveCopyAs Filename:=strFileB
If Err.Number <> 0 Then
MsgBox "Save to " & strFileB & " failed"
Err.Clear
End If
On Error GoTo 0

On Error Resume Next
ActiveWorkbook.SaveCopyAs Filename:=strFileB2
If Err.Number <> 0 Then
MsgBox "Save to " & strFileB2 & " failed"
Err.Clear
End If
On Error GoTo 0

End Sub

 

[livetohike]

ThisWorkbook is the workbook that owns the code--not the active workbook.

So when you moved the code into your personal.xls workbook, ThisWorkbook became
Personal.xls.

So try changing each occurence of ThisWorkbook to ActiveWorkbook:
strFileA = ThisWorkbook.Name
becomes
strFileA = ActiveWorkbook.Name

And excel's VBA has another way to save a backup. Then you don't have to do
that last .SaveAs to get back to the name you started with. (Check VBAs help
for .savecopyas.)

Option Explicit
Sub CopyToTwoLocations()

Dim strFileA As String
Dim strFileB As String
Dim strFileB2 As String

If ActiveWorkbook.Path = "" Then
MsgBox "Please save this workbook first!"
Exit Sub
End If

'Save first just to be safe
ActiveWorkbook.Save

'Save the name of the current doc
strFileA = ActiveWorkbook.Name

'Define backup paths
strFileB = "C:\My Documents\SaveToTwoLocations\" & strFileA
strFileB2 = "H:\SaveToTwoLocations\" & strFileA

'Save backups
On Error Resume Next
ActiveWorkbook.SaveCopyAs Filename:=strFileB
If Err.Number <> 0 Then
MsgBox "Save to " & strFileB & " failed"
Err.Clear
End If
On Error GoTo 0

On Error Resume Next
ActiveWorkbook.SaveCopyAs Filename:=strFileB2
If Err.Number <> 0 Then
MsgBox "Save to " & strFileB2 & " failed"
Err.Clear
End If
On Error GoTo 0

End Sub



livetohikewrote:

Just perfect!
Thanks