Hi. I use the following code to create separate file copies of some of my sheets. Opening the resulting copy files has worked well for over 5 years and now suddenly I am getting the error in the attached image. when Itry to open the files
Sub oSave_Individual_Numeric_S
heets_As_F
iles()
Dim oDate As String
Dim oHole As String
Dim oLevel As String
Dim oShaft As String
Dim oSheetName As String
Dim xPath As String
Dim xWs As Worksheet
Dim xWb As Workbook
Set xWb = Application.ThisWorkbook
Dim F As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Application.ScreenUpdating
= False
Application.DisplayAlerts = False
On Error GoTo EH
xPath = ActiveWorkbook.Path
For Each xWs In ActiveWorkbook.Worksheets
oSheetName = xWs.Name
If IsNumeric(oSheetName) = True Then
oDate = VBA.Format(xWs.Range("F7")
.Value, "yyyy MMM dd")
oHole = xWs.Range("F8").Value
oLevel = VBA.Mid(xWs.Range("F9").Va
lue, 1, 2)
oShaft = xWs.Range("J12")
xWs.Copy
'****Get the right file format for the version of Excel
If Val(Application.Version) < 12 Then
FileExtStr = ".xls": FileFormatNum = -4143
Else
Select Case xWb.FileFormat
Case 51:
FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If Application.ActiveWorkbook
.HasVBProj
ect Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56:
FileExtStr = ".xls": FileFormatNum = 56
Case Else:
FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
'First save new workbook to shaft named folder
F = xPath & "\Individual Holes\" & oDate & " " & oShaft & " " & oLevel & " " & oHole & FileExtStr
ActiveWorkbook.SaveAs Filename:=F, FileFormat:=FileFormatNum
ActiveWorkbook.Close False
End If
Next
Application.DisplayAlerts = True
Exit Sub
EH:
MsgBox Err.Description & " eh55"
Application.DisplayAlerts = True
End Sub