Code throwing 1004 Error

[Terry Echols]

This code has worked for years until recently (this month). Now all of a sudden it is throwing the dreaded Runtime Error 1004 "Application-defined or Object-defined error"

I have tried everything I can think of but the error keeps showing up every time I run the code. Can anyone shed some light on this error from the code below, please.

I'm using Office 365

Sub DataExtract()

With Application
 .DisplayAlerts = False
 .ScreenUpdating = False
End With

Dim i As Long
Dim j As Long
Dim k As Long
Dim objFSO As Object
Dim objFolder As Object
Dim objFile  As Object
Dim wb As Workbook

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(ThisWorkbook.Path & "\Statements\")

For Each objFile In objFolder.Files
    If InStr(objFile, ".xls") Then
        Workbooks.Open (objFile)
    End If
    Set wb = ActiveWorkbook
    i = Sheet1.Cells(Rows.Count, "B").End(xlUp).Row + 1
    j = wb.Sheets("Statement").Cells(Rows.Count, "C").End(xlUp).Row
    If wb.Sheets("Statement").Range("C13") <> vbNullString Then
        wb.Sheets("Statement").Range("A13:F" & j).Copy
        Sheet1.Range("B" & i).PasteSpecial xlPasteValuesAndNumberFormats
        wb.Sheets("Statement").Range("I13:I" & j).Copy
        Sheet1.Range("H" & i).PasteSpecial xlPasteValuesAndNumberFormats
        k = Sheet1.Cells(Rows.Count, "B").End(xlUp).Row
        wb.Sheets("Statement").Range("F6").Copy
        Sheet1.Range("A" & i & ":A" & k).PasteSpecial
        Application.CutCopyMode = False
    End If
    wb.Close
Next

Sheet1.Range("A1") = "All Invoices: " & Format(Date, "mmmm d, yyyy") & ", Week " & Format(Date, "ww")
'Align & Format Date text cell
Range("A1").RowHeight = 30
Range("A1").Font.Name = "Arial"
Range("A1").Font.Size = 16
Range("A1").IndentLevel = 1
Range("A1").VerticalAlignment = xlCenter
Range("A1").HorizontalAlignment = xlGeneral

MsgBox "Task Complete!"

With Application
 .EnableEvents = True
 .ScreenUpdating = True
 .Calculation = xlCalculationAutomatic
End With

End Sub

Thanks in advance...
Terry E

 

[Fluff]

That looks like a temp file, is the code located in SCM Enterprises.xlsm?

 

[Terry Echols]

Well I got, finally, that there was a hidden file. I removed that and now get a new error.

Run-time error '9'
subscript out of range

I don't know what this one means.

Terry E

 

[Fluff]

It means that the sheet you are referencing does exist in that workbook

 

[Terry Echols]

Now I'm more confused. None of the programming calls sheets by name. It loops through all workbooks in the folder.

Also, am I missing something on getting the VB popup box to give me the debug option? I'm on Windows 10 and I'm using Subscription Office 365.

Terry E

 

[Fluff]

Which code are you talking about? The code in your OP, or the code in post#10?

Why you are not getting the standard "Debug" window, I have no idea, unless MS have changed it (which I doubt)

 

[Terry Echols]

The op (below). None of the programming calls anything by name except the sheet name "Statement" and all of my workbooks have been created from a template so they are ALL identical to each other. Like I said, up until last week this macro worked.

Sub DataExtract()

With Application
 .DisplayAlerts = False
 .ScreenUpdating = False
End With

Dim i As Long
Dim j As Long
Dim k As Long
Dim objFSO As Object
Dim objFolder As Object
Dim objFile  As Object
Dim wb As Workbook

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(ThisWorkbook.Path & "\Statements\")

For Each objFile In objFolder.Files
    If InStr(objFile, ".xls") Then
        Workbooks.Open (objFile)
    End If
    Set wb = ActiveWorkbook
    i = Sheet1.Cells(Rows.Count, "B").End(xlUp).Row + 1
    j = wb.Sheets("Statement").Cells(Rows.Count, "C").End(xlUp).Row
    If wb.Sheets("Statement").Range("C13") <> vbNullString Then
        wb.Sheets("Statement").Range("A13:F" & j).Copy
        Sheet1.Range("B" & i).PasteSpecial xlPasteValuesAndNumberFormats
        wb.Sheets("Statement").Range("I13:I" & j).Copy
        Sheet1.Range("H" & i).PasteSpecial xlPasteValuesAndNumberFormats
        k = Sheet1.Cells(Rows.Count, "B").End(xlUp).Row
        wb.Sheets("Statement").Range("F6").Copy
        Sheet1.Range("A" & i & ":A" & k).PasteSpecial
        Application.CutCopyMode = False
    End If
    wb.Close
Next

Sheet1.Range("A1") = "All Invoices: " & Format(Date, "mmmm d, yyyy") & ", Week " & Format(Date, "ww")
'Align & Format Date text cell
Range("A1").RowHeight = 30
Range("A1").Font.Name = "Arial"
Range("A1").Font.Size = 16
Range("A1").IndentLevel = 1
Range("A1").VerticalAlignment = xlCenter
Range("A1").HorizontalAlignment = xlGeneral

MsgBox "Task Complete!"

With Application
 .EnableEvents = True
 .ScreenUpdating = True
 .Calculation = xlCalculationAutomatic
End With

End Sub

Terry E

 

[Fluff]

Best guess is that either one of the workbooks does not have a sheet called "Statement" (may have been changed or deleted), or the workbook containing the code does not have a sheet with the codename "Sheet1"

 

[Terry Echols]

Eureka!

First off, thanks for all the help. The problem was another VERY hidden file. Unchecking the "show hidden..." did not show this file, it was "desktop.ini". Once I found it, and I only found it with the 2nd set of code I posted that had the ~?CMS file displayed. I missed this one in the list because it simply showed up in the "Ds" instead of at the bottom of the list like the ~?CMS file did.

The code is working now and I want to say a big thank you for taking the time to help.

Terry E

 

[Fluff]

Glad you sorted it & thanks for the feedback