Canada Flag

Back



Sub Temporary_Name()
'Written by Barrie Davidson
Dim FileSaveName As String
Dim Counter As Integer
Dim OpenWorkBooks_Count As Integer
Dim ActiveFile As String

'Identify the Active file's window
ActiveFile = ActiveWorkbook.Name
'Set the counter
Counter = 1
'Count the number of open workbooks
OpenWorkBooks_Count = Application.Windows.Count
'Check to see if "Snow Contracts" is already open
'Loop through all open workbooks
Do Until Counter > OpenWorkBooks_Count
'If the workbook is hidden do nothing, otherwise check the name
If Windows(Counter).Visible = True Then
Windows(Counter).Activate
If ActiveWorkbook.Name = "Snow Contracts.xls" Then
'If "Snow Contracts" is open bypass the command to open it
GoTo ByPass
End If
Else
End If
Counter = Counter + 1
Loop
'If "Snow Contracts" is not open, open it
Workbooks.Open FileName:="C:\Snow Contracts.xls"
ByPass:
'Go to your original file
Workbooks(ActiveFile).Activate
'Get the new file name
FileSaveName = Application.GetSaveAsFilename(, "Microsoft Excel Workbook (*.xls),*.xls")
'Save the file
ActiveWorkbook.SaveAs (FileSaveName)
'Close the file
ActiveWorkbook.Close
'Activate the "Snow Contracts" file
Workbooks("Snow Contracts.xls").Activate
'Go to the first empty cell in column A
Range("A1").End(xlDown).Offset(1, 0).Select
'Input the file name in the selected cell
Selection.Value = FileSaveName
'Add the hyperlink
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=FileSaveName
'Close the "Snow Contracts" file
ActiveWorkbook.Close

End Sub

Copyright © 2001 by Barrie R. Davidson
Added November, 2001