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