Scooter172
05-20-2010, 05:50 PM
Have a Private sub routine that now fails when I use it is Office 2007. It does everything except save to correct Location. It will not save as a xlsm but instead saves as xls and I then get a warning that macros will not run in xls book. Click yes to stop macros or no to choose how to save it. The Sub is below..
Private Sub Workbook_Open()
If IsEmpty(ThisWorkbook.Sheets("Markup").[OpsDate]) Then
markupDispatcher = InputBox("Insert your name...", "This markup proudly created by...", "Enter Name Here")
If markupDispatcher = 5614 Then Exit Sub 'maintenance bypass key
[markupDisp] = markupDispatcher
If IsEmpty([markupDisp]) Then [markupDisp] = "[markup dispatcher name]"
ThisWorkbook.Sheets("Markup").[OpsDate] = Date + 1
If Month([OpsDate]) < 10 Then
fMonth = 0 & Month([OpsDate])
Else
fMonth = Month(ThisWorkbook.Sheets("Markup").[OpsDate])
End If
' Add a leading zero in front of single digit days
If Day([OpsDate]) < 10 Then
fDay = 0 & Day([OpsDate])
Else
fDay = Day([OpsDate])
End If
fDate = Year([OpsDate]) & "-" & fMonth & "-" & fDay & " " & WeekdayName(Weekday([OpsDate]), True)
fName = "C:\Users\Scott\Documents\Ops Transit\Ops Table " & fDate & ".xlsm"
' If the file name already exists, SaveAs will ask to overwrite. If "No" is chosen an error will occur.
On Error Resume Next 'Skip the SaveAs if an error occurs
ThisWorkbook.SaveAs Filename:=fName, AddToMru:=True
End If
End Sub
' Alternate routine: Open a Save As dialog box and suggest a name that fits the naming format
' Save the file only IF the user does not cancel out of the Save As Dialog box.
' fName = Application.GetSaveAsFilename("C:\Users\Scott\Documents\Ops Transit\Ops Table " & fDate & ".xlsm")
' If fName <> False Then ThisWorkbook.SaveAs Filename:=fName, AddToMru:=True
Private Sub Workbook_Open()
If IsEmpty(ThisWorkbook.Sheets("Markup").[OpsDate]) Then
markupDispatcher = InputBox("Insert your name...", "This markup proudly created by...", "Enter Name Here")
If markupDispatcher = 5614 Then Exit Sub 'maintenance bypass key
[markupDisp] = markupDispatcher
If IsEmpty([markupDisp]) Then [markupDisp] = "[markup dispatcher name]"
ThisWorkbook.Sheets("Markup").[OpsDate] = Date + 1
If Month([OpsDate]) < 10 Then
fMonth = 0 & Month([OpsDate])
Else
fMonth = Month(ThisWorkbook.Sheets("Markup").[OpsDate])
End If
' Add a leading zero in front of single digit days
If Day([OpsDate]) < 10 Then
fDay = 0 & Day([OpsDate])
Else
fDay = Day([OpsDate])
End If
fDate = Year([OpsDate]) & "-" & fMonth & "-" & fDay & " " & WeekdayName(Weekday([OpsDate]), True)
fName = "C:\Users\Scott\Documents\Ops Transit\Ops Table " & fDate & ".xlsm"
' If the file name already exists, SaveAs will ask to overwrite. If "No" is chosen an error will occur.
On Error Resume Next 'Skip the SaveAs if an error occurs
ThisWorkbook.SaveAs Filename:=fName, AddToMru:=True
End If
End Sub
' Alternate routine: Open a Save As dialog box and suggest a name that fits the naming format
' Save the file only IF the user does not cancel out of the Save As Dialog box.
' fName = Application.GetSaveAsFilename("C:\Users\Scott\Documents\Ops Transit\Ops Table " & fDate & ".xlsm")
' If fName <> False Then ThisWorkbook.SaveAs Filename:=fName, AddToMru:=True