Excel VBA でFunctionが呼び出せません

Question

お世話になります。 VBA初級者です。あるサブディレクトリ以下を再帰的に読みだして複数のExcelファイルから「名前」「日付」セルの値、および「ファイル名」を取り出し、呼び出し元のブックに記載していきたいと思います。ネット上のコードを頼りにして、以下のようにVBAを組みました。しかし、イミディエイトウィンドウなどを見てもFunctionの呼び出しに失敗しているようで、ファイル名のみが呼び出し元に記載される状態です。この場合、どのようにすればFunctionを呼び出し、期待通りの動作をしますでしょうか？何卒ご教示いただけますと幸いです。以下コードです。 --------------------------------------------------------------------------------------------------- Dim buf As String, f As Object Dim cnt As Long Dim wFile As String Dim wFilePath As String Dim i As Long 'ボタンをクリックした時の処理 Public Sub mainroutine() cnt = 0 Call subroutine("\xxxx\xxxx\xxxx") 'Excelファイルが存在していたらファイル名を返す wFile = Dir(buf & "\■*.xlsm") '先頭行を指定 i = 2 'カレントディレクトリに存在するExcelファイルを全て読み込む Do While wFile <> "" '開くExcelファイルのフルパスを取得 wFilePath = ActiveWorkbook.Path & "" & wFile '名前・日付を取得し配列に格納する（区切り文字：|） strData = Split(fileLoad(wFilePath), "|") '名前 Cells(i, 1) = strData(0) '日付 Cells(i, 2) = strData(1) 'ファイル名 Cells(i, 3) = wFile '次のExcelファイルを取得 wFile = Dir() '行数をカウント i = i + 1 Loop End Sub 'Excelファイルを開いてデータを取得 '戻り値：名前|日付　（ | で区切る） Function fileLoad(ByVal wFilePath As String) As String Dim CurBookName As Variant Dim ColNo As Long Dim RowNo As Long Dim strValue As String Dim FoundCell As Range Dim i As Long 'ファイルを開く Workbooks.Open wFilePath '開いたExcelのファイル名を取得 CurBookName = Application.ActiveWorkbook.Name '検索する項目を配列に格納 wItem = Array("名前", "日付") '検索する For i = LBound(wItem) To UBound(wItem) Set FoundCell = Worksheets("yyyyyyyyy").Cells.Find(What:=wItem(i)) If FoundCell Is Nothing Then '検索出来なかった場合 If i = 0 Then strValue = "" Else strValue = strValue & "|" End If Else '検索したセルに移動 FoundCell.Select ColNo = ActiveCell.Column '列番号を取得 RowNo = ActiveCell.Row '行番号を取得 '住所を取得する If i = 0 Then '最初の項目 strValue = Cells(RowNo + 1, ColNo).Value Else '2番目以降の項目は|で区切る strValue = strValue & "|" & Cells(RowNo + 1, ColNo).Value & "|" End If End If Next i '結果を返す fileLoad = strValue '開いたExcelファイルを閉じる Application.DisplayAlerts = False '確認メッセージの非表示 Workbooks(CurBookName).Close Application.DisplayAlerts = True '確認メッセージの表示 End Function Sub subroutine(Path As String) buf = Dir(Path & "\■*.xlsm") Do While buf <> "" cnt = cnt + 1 Cells(cnt, 1) = buf buf = Dir() Loop With CreateObject("Scripting.FileSystemObject") For Each f In .GetFolder(Path).SubFolders Call Sample3(f.Path) Next f End With End Sub

Qchan1962 · Accepted Answer

＃３＃５です。
＞ネット上のコードを頼りに
デバッグも理解されているようですので、余計なお世話かもしれませんが、
再帰的処理でサブフォルダ内の条件に合うファイルをWorkbooks.Open出来るプロシージャ（以前回答した）を書きます。
よろしかったらお使いください。（今更感があれば、忘れてください）
また、ステップ実行などで内容を確認してご理解いただくと良いかと思います。
パスやシート名がない場合のエラー処理は、個別に行うかコメントブロックのOn Error Resume Nextで対応してください。
On Error Resume Nextで対応した場合、コード内のIf IsEmptyArray(TargetFile) = True Then Exit Sub（配列が空の場合のエラー処理）　や
Public Function IsEmptyArray(arrayTmp As Variant) As Booleanは不要です。

ターゲットブックの処理はコメントブロックしていますので参考にしてください。
肝心の抽出部分や書き出し部分は、書いていませんが、データが多い様であれば、配列などに入れ一度に書き出すのが良いと思います。

Option Explicit
Dim n As Long
Dim TargetFile()
Sub StartProgram()
　　Dim i As Long, filepath As String
　　filepath = "\xxxx\xxxx\xxxx"
　　'　　On Error Resume Next
　　Erase TargetFile
　　n = 0
　　Call getFileList(filepath)
　　Application.ScreenUpdating = False
　　Application.DisplayAlerts = False
　　If IsEmptyArray(TargetFile) = True Then Exit Sub
　　For i = 0 To UBound(TargetFile)
'　　　　With Application.Workbooks.Open(TargetFile(i))
'　　　　　　Worksheets("yyyyyyyyy").Activate
'
'
'　　　　　　.Save
'　　　　　　.Close
'　　　　End With
　　Next
　　Application.DisplayAlerts = True
　　Application.ScreenUpdating = True
End Sub
Sub getFileList(filepath)
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim objFol As Object, objFile As Object
　　For Each objFol In FSO.GetFolder(filepath).SubFolders
　　　　Call getFileList(objFol.Path)
　　Next
　　For Each objFile In FSO.GetFolder(filepath).Files
　　　　If objFile.Name Like "■*.xlsm" Then
　　　　　　ReDim Preserve TargetFile(n)
　　　　　　TargetFile(n) = objFile.Path
　　　　　　n = n + 1
　　　　End If
　　Next
End Sub
Public Function IsEmptyArray(arrayTmp As Variant) As Boolean
　　On Error GoTo ERROR_
　　If (0 < UBound(arrayTmp, 1)) Then
　　　　IsEmptyArray = False
　　Else
　　　　IsEmptyArray = True
　　End If
　　Exit Function
ERROR_:
　　IsEmptyArray = True
End Function

bonaron · Answer

内容をきっちり読んだ訳ではありませんが

> Call Sample3(f.Path)
は
Call subroutine(f.Path)
ではないでしょうか？

fujillin · Answer

こんにちは

ざっと見ただけですが、
＞Functionの呼び出しに失敗しているようで
なんだかそれだけでは無いように思われます。
エラーが出ていませんかね？

とりあえず気が付いた点を・・・
・フォルダパスを
　＞wFile = Dir(buf & "\■*.xlsm")
　で走査しているのに、処理しようとしているのは
　＞wFilePath = ActiveWorkbook.Path & "\" & wFile
　となっているみたいなので、どうなっているのでしょうね。
　（buf = ActiveWorkbook.Path であるとは思えないので）

・Function内にいきなり
　＞FoundCell.Select
　とか
　＞ColNo = ActiveCell.Column
　などとありますが、これってエラーの原因になりやすいです。
　（エラーが出ていないのなら、偶然と思ってもよいくらい）

他にもいろいろありそうですが、デバッグのコツとして全体でいきなりテストするのではなく、各パーツが正しく動作することを確認してから、全体でテストするという手順の方が効率が良いと思われます。

Qchan1962 · Answer

こんにちは、
環境を作成してデバッグをしてくれる方は、なかなかいないと思いますので、ステップ実行でデバッグをしてもう少し詳細が欲しいですかね。
エラー無く検証できているのなら良いのですが、
どこかにOn Error Resume Nextのようなものを入れているなら
外して検証した方が良いと思います。

Function内を読んで気になる点だけ（FSOやパスなどは考えていません）
変数宣言がされているものされていないものがあるので、モジュールの初めにOption Explicitを追加して宣言した方が良いかと

strData = Split(fileLoad(wFilePath), "|")
Splitで使用する事とwItem = Array("名前", "日付")であることから
作成文字列の最後に"|"は不要だと思います。
LBound(wItem) To UBound(wItem)は、必ず　0 to 1なので"|"が2つある
必要がありません。（あっても構わないけど）

以下が問題なのかも、、、
Set FoundCell = Worksheets("yyyyyyyyy").Cells.Find(What:=wItem(i))
対象ブックを開いた時にWorksheets("yyyyyyyyy")がActiveSheetである保証が無いように思いますので、取得できているのかな？と思います。
Workbooks.Open wFilePath
Worksheets("yyyyyyyyy").ActivateやWorksheets("yyyyyyyyy").Select
が必要ではないでしょうか？

参考まで

fujillin · Answer

No2です

＞Functionが呼び出せないのでさらに意味が分からなくなってしまいました。

呼び出し側は、
＞strData = Split(fileLoad(wFilePath), "|")
だと思いますが、例えば
　tmp = fileLoad(wFilePath)
　Debug.Print "returned: " & tmp
などとして、戻り値がどうなっているか確認するとか、

あるいは、Function側に
　Debug.Print "Function Called!"
などを入れておくと、実際に呼び出されて いる／いない のかを確認できるはずです。

まずは、実際に何が起きているのかを確かめることが先決かと思います。

Qchan1962 · Answer

＃３です
＃２さんがすでに回答されている通り、
Do While buf <> ""なので再帰処理から戻ってきたときはbufは""のはずです
従って、wFile = Dir(buf & "\■*.xlsm")は取得できないと思います。
これを回避するのであれば、Sub subroutine(Path As String)内で
ファイルのフルパスを取得して、配列などに入れる必要があります。
ファイル名をA列に書き出しているようですので、B列に書き出すような対応でも良さそうですね。
例えば、Cells(cnt, 2).Value = f.Path

いっそのこと、wFile = Dir(Cells(i, 2) & Cells(i, 1))みたいでも？
ちなみに行番号　i=2  ? subroutineでは1行目から書かれているような気がします。
未検証なので参考まで

fujillin · Answer

No4です

＞Function以下は呼び出されてもいない、という状況でした。
呼び出されていないなら、その文が実行される前に何かが起きているはずです。
例えば、ループがショートカットされているとか。

＞wFile = Dir(buf & "\■*.xlsm")
の直後に、WFileの内容を確認してみてください。
（""ならループそのものが実行されない）

＞wFilePath = ActiveWorkbook.Path & "\" & wFile
の直後に、WFilePathの内容を確認してください。
思った通りのファイルパスになっていますか？
（なっていないのではないかと推測。）

※ デバッグ用の「ブレークポイント」や「ウォッチ式」を活用なさると効率的に確認できるのではないかと思います。

fujillin · Answer

NO6です

＞wFileの内容を確認してみたところ""でした。
であれば、ほとんど何も処理されないので、Functionも呼び出されることはないですよね？

なんとなくですが、全体の構成から考え直した方が良さそうに思われます。

確認してはいませんが、Dir関数は実体が1つしか存在しないと思いますので、Dir()で呼び出す際の内容が変化しないようにしておかないとうまくいかないのではなかろうかと思います。

これまた未確認ですが、FileSystemObjectでも同様のことは可能と思いますので、（FileSystemObjectも利用しているようなので）こちらに切り替えた方が再帰に関してはうまくいきそうな気がしますが・・・

fujillin · Answer

No7です

各ファイル内の検索をちょっと見てみましたが、シート全体から"名前"（"日付"）のセルを検索しているようですが、なんだかちょっとアバウトすぎませんか？

想像するところ、タイトルの項目を検索しているものと思いますが、列の位置が決まっているとか何かありそうな気もするのですが。
…というのも、特別な名称ならいざしらず、"名前"（"日付"）はそれなりにありがちなタイトルなので、想定したものとは違うところでヒットする可能性がありそうにも思えますので…

Excel VBA でFunctionが呼び出せません

内容をきっちり読んだ訳ではありませんが

こんにちは

こんにちは、

No2です

＃３です

No4です

NO6です

＃３＃５です。

No7です

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング