フォルダ内全ファイルからデータを取得する方法

質問

お力をお貸しください。

下記のようなコードを書きました。*ドライブにあるフォルダ内全ファイルからデータを取得して、一つの表にまとめようとしています。
が、Workbooks.Open sFileで、「ファイルが存在しません」というエラーがでます。
変数を確認しましたが、きちっと呼び込んでいるのに、ファイルが存在しないとなるのが分かりません。

ここで、データの最終行を取得するのに、ややっこしいコードを書いているのは、データが虫食い状態で、全部のセルが埋まっているのはC列しかないため、このようなことになっています。

よろしくお願いします。

Sub Macro1()

Dim FName As String, FPath As String, cnt As Long, r As Long, m As Long, MyMonth As String
Dim LastRows As Long

Set Wsh = CreateObject("Wscript.Shell")
Set Wsh = Nothing

m = Range("A1").Value - 1
MyMonth = m & "月"

FPath = "*:\" & MyMonth & "\"
ChDir FPath
FName = FPath & "*.xls"
sFile = Dir(FPath 　& "*")

' 画面更新オフ
Application.ScreenUpdating = False

With ThisWorkbook.Sheets(1)
LastRows = Cells(Rows.Count, 1).End(xlUp).Row + 1

Do While sFile <> ""
If sFile <> ThisWorkbook.Name Then
Workbooks.Open sFile
cnt = Cells(Rows.Count, 3).End(xlUp).Row + 1
ActiveSheet.Range("A1:" & "M" & cnt).Copy Destination:=ThisWorkbook.Sheets(1).Cells(LastRows, 1)
ActiveWorkbook.Close SaveChanges:=False
sFile = Dir()
End If
Loop
End With

'画面更新オン
Application.ScreenUpdating = True

''名前をつけて保存
'
' Application.DisplayAlerts = False
' Filedate = Format(Date, "yyyymm")
' ActiveWorkbook.SaveAs Filename:=FPath & "\" & Filedate & ".xls"
' Application.DisplayAlerts = True
'
''画面更新オン
'Application.ScreenUpdating = True
'
'
End Sub

回答No.1

NotFound404 · ベストアンサー

作りかけ ＆ 部分的に抜き出したコードのようなので見当違いかも。
FPath = "*:\" & MyMonth & "\" '指定が間違っていませんか？
ChDir FPath
msgbox curdir 'フォルダの確認をしてみる。

とか
Do While sFile <> ""
msgbox sfile '確認メッセージを出してみる
If sFile <> ThisWorkbook.Name Then
Workbooks.Open sFile

などをやってみてください。

補足

NotFound404さん

いつも助けてくださって、ありがとうございます。

イミディエイトで確認していたのですが、
パスがめちゃくちゃでした。

以前に作ったものを貼り付けたのですが、
動かなかったので、いろいろいじっているうちに
どつぼにはまってしまったというか、ぐちゃぐちゃでした。

改めて、書き直して動きました。

書き直したコードは下記のとおりです。

ありがとうございました。

Sub 集計()

Dim sDPath As String, sFile As String, cnt As Long, sFilePath As String, m As Long, MyMonth As String

m = Range("A1").Value - 1
MyMonth = m & "月"

Set Wsh = CreateObject("Wscript.Shell")
sDPath = "*:\****\" & MyMonth
sFile = Dir(sDPath & "\" & "*.xls")

sFilePath = sDPath & "\" & sFile
Set Wsh = Nothing

'画面更新オフ
Application.ScreenUpdating = False

'Kドライブにある前月のフォルダの中にあるすべてのエクセルファイルのデータを取得
Do While sFile <> ""
If sFile <> ThisWorkbook.Name Then
cnt = Cells(Rows.Count, 1).End(xlUp).Row + 1
Workbooks.Open sFilePath

Columns("A:B").Delete

ActiveSheet.UsedRange.Resize(Cells(Rows.Count, 1).End(xlUp).Row).Copy Destination:=ThisWorkbook.Sheets(1).Cells(cnt, 1)
ActiveWorkbook.Close SaveChanges:=False

sFile = Dir()
End If
Loop

'画面更新オン
Application.ScreenUpdating = True

'名前をつけて保存

Application.DisplayAlerts = False
Filedate = Format(Date, "yyyymm")
ActiveWorkbook.SaveAs Filename:=sDPath & "\" & "*****" & Filedate & ".xls"
Application.DisplayAlerts = True

'画面更新オン
Application.ScreenUpdating = True

End Sub