vbaのエラー対応（実行時エラー7：メモリが不足しています)

xmlファイルを開いて順にコピペする記述です。
処理は一応できているのですが、処理が終わった後に、タイトルにある実行時エラー７がいつも出てしまい、気持ち悪いです。どのように記述を訂正すればいいか、アドバイスいただけないでしょうか。

Sub OpenFilesInFolder()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim path, fso, file, files
Dim target As Long
path = ThisWorkbook.path & "\"
'xmlﾌｧｲﾙを開く処理
Set fso = CreateObject("Scripting.FileSystemObject")
Set files = fso.GetFolder(path).files
'フォルダ内の全ファイルについて処理
For Each file In files
'ファイルを開いてブック、シートとして取得
Dim wb As Workbook
Dim ws As Worksheet
'xmlﾌｧｲﾙを開く処理
Workbooks.OpenXML _
Filename:=file.path, LoadOption:=xlXmlLoadImportToList
Set wb = ActiveWorkbook
Set ws = ActiveSheet
'開いたxmlﾌｧｲﾙを順にコピペ処理
With ThisWorkbook.Worksheets(1)
target = .Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Range(ws.Cells(2, 25), ws.Cells(49, 25)).Copy
.Range(.Cells(target, 1), .Cells(target + 47, 1)).PasteSpecial Paste:=xlPasteValues
ws.Range(ws.Cells(2, 27), ws.Cells(49, 27)).Copy
.Range(.Cells(target, 2), .Cells(target + 47, 2)).PasteSpecial Paste:=xlPasteValues
ws.Range(ws.Cells(2, 28), ws.Cells(49, 28)).Copy
.Range(.Cells(target, 3), .Cells(target + 47, 3)).PasteSpecial Paste:=xlPasteValues
End With
'保存せずに閉じる
wb.Close SaveChanges:=False
Next file
DoEvents
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

No.4 ベストアンサー 回答者： Qchan1962 回答日時： 2023/04/24 12:55

こんにちは

何かの改造で使われているのでしょうか・・・
原因はすでに回答にあるところかなと思いますが
"Scripting.FileSystemObject"を使用しなければスッキリすると思うのと処理も速くなるのではないかと思います
一例です

Sub XmlDataToSheet()
Dim path As String
Dim file As String
Dim target As Long
Dim wb As Workbook
Dim ws As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
path = ThisWorkbook.path & "\"
file = Dir(path & "*.xml") 'パス配下拡張子「.xml」の最初のファイル名を返す
Do While file <> "" 'Dir関数がファイル名を返さなくなるまで繰り返す
'xmlﾌｧｲﾙを開く処理
Set wb = Workbooks.OpenXML _
(Filename:=path & file, LoadOption:=xlXmlLoadImportToList)
Set ws = wb.ActiveSheet
With ThisWorkbook.Worksheets(1)
target = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(target, 1).Resize(48, 1).Value = ws.Range("Y2:Y49").Value
.Cells(target, 2).Resize(48, 2).Value = ws.Range("AA2:AB49").Value
End With
'保存せずに閉じる
wb.Close SaveChanges:=False
file = Dir '次のファイル名を返す
Loop

ThisWorkbook.Worksheets(1).Columns("A:C").AutoFit
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

この回答へのお礼

ありがとうございます。
すごくスピードが上がって、大変勉強になりました。

お礼日時：2023/04/24 19:20

No.3 回答者： tatsumaru77 回答日時： 2023/04/24 08:45

提示されたマクロの場合、自分自身のファイル（マクロを格納したexcelブック）もオープンしてしまいます。

あなたが開こうとしているxmlファイルの拡張子が".xml"であるという前提になりますが、以下のようにしてはいかがでしょうか。
拡張子が".xml"のファイルのみを開くように変えました。

こちらに投稿するとエラーになるので、下記にアップしました。
https://ideone.com/rMuP9l

この回答へのお礼

なるほど、そういうことでしたか。
大変勉強になりました。
ありがとうございます。

お礼日時：2023/04/24 19:19

No.2 回答者： 初心者ですが何か。 回答日時： 2023/04/24 07:44

値だけならコピペより代入の方が良いのかもですけど、コピー元のデータを溜め込まないよう

https://www.sejuku.net/blog/79196

にて

'保存せずに閉じる
wb.Close SaveChanges:=False
'クリップボードにコピーした内容をクリアする
Application.CutCopyMode = False '★　追加
Next file

１処理毎にクリアしてしまうとか？

No.1 回答者： かわごえ 回答日時： 2023/04/24 01:05

開くファイルが多すぎるのでは

そんだけコピペする必要があるのでしょうか。。。
インポートでは出来ないんでしたっけ
https://support.microsoft.com/ja-jp/office/xml-% …