VBA 実行自エラー'1004' アプリケーション定義またはオブジェクトエラー

Dim myCon As New ADODB.Connection
Dim myRecordSet As New ADODB.Recordset
Dim mySQL As String
Dim i As Integer
Dim ws1, ws2 As Worksheet
Dim sRow As Long, eRow As Long
Dim sCol As Long, eCol As Long, colCnt As Long
Dim str, codeInfo, Stall1, Stall2, Stall3, Stall4, PreStall1, PreStall2, PreStall3, PreStall4 As String
Private Const mySheetName As String = "作業コードデータ"
Private Const dbFile As String = "\\Vs-picman\Users\admin_SK\TPOD\TPOD.accdb"
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)

Sub Read()


'Application.ScreenUpdating = False ' 描画を停止する





'_________________________変数の宣言１'_________________________

'フォルダの場所を変数に入れる
    Dim Folder_path
    Folder_path = "\\Vs-picman\Users\admin_SK\TPOD_test\TPOD\Export"
'集計するブックを変数に入れる
    Dim ImportWorkbook
    ImportWorkbook = Dir(Folder_path & "\************.xlsx")

  Dim startTime As Double
  Dim endTime As Double
  Dim processTime As Double

'_________________________コピペ処理の実行'_____________________


'指定したフォルダから、Excelファイルを探す
Application.ScreenUpdating = False              '画面の描画更新を停止する

'    Do Until ImportWorkbook = ""
    
        Dim objFileSys As Object
        Dim fileName As String
    
        'ファイルシステムを扱うオブジェクトを作成
        Set objFileSys = CreateObject("Scripting.FileSystemObject")
     
        '拡張子無しのファイル名を取得
        fileName = objFileSys.GetBaseName(Folder_path & "\" & ImportWorkbook)
        Debug.Print fileName
        Set objFileSys = Nothing

        Workbooks.Open fileName:=Folder_path & "\" & ImportWorkbook

         


'Sheet1_________________________________________________________
        
        With Workbooks(ImportWorkbook).Sheets(1).Range("A1").CurrentRegion
            sRow2 = .Item(1).Row
            sCol2 = .Item(1).Column
            eRow2 = .Rows.Count + sRow2 - 1
            eCol2 = 23
            
        End With

        
        '_____________________________________________
        Set ws1 = ThisWorkbook.Worksheets("作業コードデータ")
        '_____________________________________________
        With ws1.Range("A1").CurrentRegion
            sRow = .Item(1).Row + 1
            sCol = .Item(1).Column
            eRow = .Rows.Count + sRow - 1
            eCol = .Columns.Count + sCol - 1
            RowCnt = Cells(Rows.Count, 1).End(xlUp).Row - 1
        End With


        Workbooks(ImportWorkbook).Sheets(1).Range(Cells(1, 1), Cells(eRow2, 23)).Copy
        ThisWorkbook.Activate
        ws1.Cells(eRow, 1).Select
        ActiveSheet.Paste
         
               
      
'            閉じる
            '集計するブックを
        Application.DisplayAlerts = False
            Workbooks(ImportWorkbook).Close
        Application.DisplayAlerts = True
        
        

        

Application.DisplayAlerts = False



'Application.Quit
ThisWorkbook.Close False

Exit Sub

' 後始末
Set fso = Nothing


Application.ScreenUpdating = True                  '画面の描画更新を有効にする



     

'Application.Quit
ThisWorkbook.Close False

     
     

' 後始末
Set fso = Nothing





End Sub