We help IT Professionals succeed at work.
Get Started

Excel VBA - File created not opening suddenly

Murray Brown
Murray Brown asked
on
37 Views
Last Modified: 2019-12-29
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

1

Sub oSave_Individual_Numeric_Sheets_As_Files()

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").Value, 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.HasVBProject 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
Comment
Watch Question
Senior Developer
CERTIFIED EXPERT
Commented:
This problem has been solved!
Unlock 1 Answer and 3 Comments.
See Answer
Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

  • Troubleshooting
  • Research
  • Professional Opinions
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE