Thanks for the help, but I haven't been able to successfully implement
your suggestions.
My main problem is that I can't define the names of the two workbooks
as suggested because they change every time the program is run.
I think posting the code is easier than an explination, I apologize for
the excess:
Sub SelectNewFile()
Dim NewFileName As String, OldFileName As String, Fdate As String,
NewName As String
Dim OldName As String, awb As Workbook, BackupFileName As String, i
As Integer
Dim OK As Boolean, astrLinks As Variant, iCtr As Long, NewW As
String
If TypeName(ActiveWorkbook) = "Nothing" Then Exit Sub
Set awb = ActiveWorkbook
If awb.Path = "" Then
Application.Dialogs(xlDialogSaveAs).Show
Else
BackupFileName = awb.Name
OK = False
On Error GoTo NotAbleToSave
If Dir("I:\Pyro-Process reports\SIC-2\" & BackupFileName) < ""
Then
Kill "I:\Pyro-Process reports\SIC-2\" & BackupFileName
End If
With awb
Application.StatusBar = "Saving this workbook..."
Save
Application.StatusBar = "Saving this workbook backup..."
SaveCopyAs "I:\Pyro-Process reports\SIC-2\" &
BackupFileName
OK = True
End With
End If
NotAbleToSave:
Set awb = Nothing
Application.StatusBar = False
If Range("B4").Value = "" Then
Range("B4").Value = InputBox("Please enter the new date",
"Date")
Else
Range("B4").Value = Range("B4").Value + 1
End If
Range("B4").NumberFormat = "mm-dd-yy;@"
Fdate = Format(Range("B4"), "mm_dd_yy")
NewFileName = "SIC_2-" & Fdate & ".xls"
' Define variable as an Excel link type.
astrLinks = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLi nks)
If IsArray(astrLinks) Then
For iCtr = LBound(astrLinks) To UBound(astrLinks)
ActiveWorkbook.BreakLink _
Name:=astrLinks(iCtr), _
Type:=xlLinkTypeExcelLinks
Next iCtr
End If
Set awb = ActiveWorkbook
' Open new file
Workbooks.Open "I:\Pyro-Process reports\SIC-2\template.xls"
-
NewW = "template.xls"
Workbooks(NewW).Worksheets(1).Range("B4").Value = _
Workbooks(BackupFileName).Worksheets(1).Range("B4" ).Value 1
-
' Save as new file using date
ActiveWorkbook.SaveAs "I:\Pyro-Process reports\SIC-2\" &
NewFileName
' Close old file
awb.Close SaveChanges:=True
Calculate
End Sub
Hopefully that explains what I am trying to do better than I can
describe. If anyone can explain or show me how to implement the date
change, I would be very grateful.
Thanks.
---
Message posted from
http://www.ExcelForum.com/