同フォルダ内のファイルすべて開きコピーするマクロ

質問

以下マクロは一昨日まで問題なく使えていたのですが、
昨日から突然「データリンクプロパティ」が表示され、
「OK」ですすむと、
「実行時エラー1004　OPENメソッドは失敗しました　Workbooksオブジェクト」で
デバッグになります。

'-------------------------------
' 指定フォルダ内のファイルからコピー
'-------------------------------
Sub ALL_COPY()
Const FolderPath As String = "\********************"　⇐ここにフォルダパスを入れています。
Dim objFSO As Object
Dim objBook As Object
Dim lngRow As Long

'画面のちらつき制御設定
Application.ScreenUpdating = False

'FileSystemObjectを変数にセット
Set objFSO = CreateObject("Scripting.FileSystemObject")

'フォルダ内のファイル全て繰り返し処理
For Each objBook In objFSO.GetFolder(FolderPath).Files
'貼り付け行(最終行+1)取得
lngRow = ThisWorkbook.Sheets("■代表").Range("E" & Rows.Count).End(xlUp).Row + 1

MsgBox (objBook)

'ファイルを開く
Workbooks.Open objBook.Path　　　　　　　　　⇐ここがデバッグになります。
'コピー最終行へ貼り付け
With ActiveWorkbook
.Sheets("■代表").Rows("3:19").Copy ThisWorkbook.Sheets("■代表").Rows(lngRow)
Application.DisplayAlerts = False

.Close
End With
Next

'フォルダ内のファイル全て繰り返し処理
For Each objBook In objFSO.GetFolder(FolderPath).Files
'貼り付け行(最終行+1)取得
lngRow = ThisWorkbook.Sheets("■投資家").Range("E" & Rows.Count).End(xlUp).Row + 1

'ファイルを開く
Workbooks.Open objBook.Path
'コピー最終行へ貼り付け
With ActiveWorkbook
.Sheets("■投資家").Rows("3:19").Copy ThisWorkbook.Sheets("■投資家").Rows(lngRow)
Application.DisplayAlerts = False

.Close
End With
Next

'オブジェクト変数解放
Set objFSO = Nothing

'画面のちらつき制御解除
Application.ScreenUpdating = True

End Sub
----------------------------------------------------------

MsgBoxの表示では、「Tumbs.db」がでてきますが、
何か関係があるのでしょうか。

どなたかお知恵をお貸しくださいませ。

回答No.2

watabe007 · ベストアンサー

>OPENメソッドは失敗しました
原因はTumbs.dbファイルを開こうとした為だと思われますので
エクセルファイルのみ開くようにしてみました。
Sheets("■投資家") と Sheets("■代表") からデーターを取得するため
それぞれにファイルを開いているようなので１度にまとめました。
参考に
Sub ALL_COPY()
　　Const FolderPath As String = "\********************"　
　　Dim objFSO As Object
　　Dim objBook As Object
　　Dim lngRow As Long

　　Application.ScreenUpdating = False
　　Set objFSO = CreateObject("Scripting.FileSystemObject")
　　For Each objBook In objFSO.GetFolder(FolderPath).Files
　　　　Select Case objFSO.GetExtensionName(objBook)
　　　　　　Case "xls", "xlsx", "xlsm"
　　　　　　　　Workbooks.Open objBook.Path
　　　　　　　　With ActiveWorkbook
　　　　　　　　　　lngRow = ThisWorkbook.Sheets("■代表").Range("E" & Rows.Count).End(xlUp).Row + 1
　　　　　　　　　　.Sheets("■代表").Rows("3:19").Copy ThisWorkbook.Sheets("■代表").Rows(lngRow)
　　　　　　　　　　lngRow = ThisWorkbook.Sheets("■投資家").Range("E" & Rows.Count).End(xlUp).Row + 1
　　　　　　　　　　.Sheets("■投資家").Rows("3:19").Copy ThisWorkbook.Sheets("■投資家").Rows(lngRow)
　　　　　　　　　　.Close
　　　　　　　　End With
　　　　End Select
　　Next
　　Set objFSO = Nothing
　　Application.ScreenUpdating = True
End Sub

回答No.1

HohoPapa

課題フォルダーに画像を保存した、
あるいは保存したことがあったために、
Tumbs.dbが作成され
このマクロが、このファイルを開こうとしてしまう。
という事態が起きているものと思います。

そもそも、
エクセルファイル以外を開こうとしてしまう
という問題があるわけですが、
それはさておき

https://www.qam-web.com/?p=12022
を参考に、削除してしまい
再作成されないようにするのが吉と思います。