Solved: Conversion

[Scooter172]

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

[mbarron]

Add the FileFormat to this line
ThisWorkbook.SaveAs Filename:=fName, AddToMru:=True
ThisWorkbook.SaveAs Filename:=fName, AddToMru:=True, FileFormat:=52
For future post please use the VBA tags. Either highlight your code and click the VBA button above the text box or click the VBA button and paste your code between the tags.

[Scooter172]

Add the FileFormat to this line
ThisWorkbook.SaveAs Filename:=fName, AddToMru:=True
ThisWorkbook.SaveAs Filename:=fName, AddToMru:=True, FileFormat:=52
For future post please use the VBA tags. Either highlight your code and click the VBA button above the text box or click the VBA button and paste your code between the tags.

Sorry just found the sight and posted... so are these 2 seperate codes

[Scooter172]

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



Is this better?

[mbarron]

Yes, much better.

My post should have been

Change this line:
ThisWorkbook.SaveAs Filename:=fName, AddToMru:=True to
ThisWorkbook.SaveAs Filename:=fName, AddToMru:=True, FileFormat:=52

[Scooter172]

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, Fileformat:=52
End If
End Sub

[Scooter172]

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, Fileformat:=52
End If
End Sub



Thank You Very much... !