フォルダのパス取得と、フォルダ内のファイルに対する一括処理について

Question

vba学習者です。

ダイアログで選択したフォルダのパスが取得できなくて困っています。ステップインで見てみると、If.Showの文でダイアログを選択すると、「オブジェクト変数またはwithブロック変数が設定されていません」と出ます。オブジェクトは指定されていると思うのですがどうしてこのようなエラーが出るのでしょうか？以前はここまでできていました‥

また、with Create以下の文を行うと、コードが書いてあるシートに処理がなされてしまい、目的のブックのシートに処理がなされないです。どう書き直せば良いでしょうか？

よろしくお願いします。

以下コードになります。

Sub 一括処理()

  Dim bkWork As Workbook '作業用ワークブック
  Dim bkSrc As Workbook 'コピー元ワークブック
  Dim folderPath As String '処理対象のフォルダパス
  Dim itm As Object
   
  'Excelファイルが保存されているフォルダを選択
  With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False '複数選択しない
    .Title = "Excelファイルが保存されているフォルダを選択"
    If .Show = True Then
      folderPath = .SelectedItems(1) '選択したフォルダのパスを変数に格納
    Else
      Exit Sub 'フォルダが選択されなかった場合は処理終了
    End If
  End With

    
  'ファイルの処理にFileSystemObjectオブジェクトを利用
  With CreateObject("Scripting.FileSystemObject")
    '指定したフォルダ内のファイルを順番に処理
    For Each item In .GetFolder(folderPath).Files
      '処理対象となるファイルの拡張子を指定
      Select Case LCase(.GetExtensionName(itm.Path))
        Case "xls", "xlsx", "xlsm", "csv"
          With Workbooks.Open(folderPath)
      
            Call test
            
            
            Application.DisplayAlerts = False   '上書き保存して閉じる
            ActiveWorkbook.Save
            ActiveWorkbook.Close
            Application.DisplayAlerts = True
                    
          End With
          
      End Select
    Next
  End With

    MsgBox "処理が終了しました", vbInformation

End Sub

Answer 1

ステップインで見てみると、

With を用いず、オブジェクト変数に Set してアクセスするようにした場合も同じエラーになりますか?

With 無しでも同じようにエラーになる場合は、参照設定の不一致かもしれません。元ファイルをバックアップしておいた上で、参照設定を可能な限り外してからファイルを閉じ、再度開きなおして参照設定を付与しなおしてみるとどうでしょうか。

また、with Create以下の文を行うと、コードが書いてあるシートに処理がなされてしまい、目的のブックのシートに処理がなされないです。

その『処理』とはどの部分を指していますか?

『処理』というのが「ActiveWorkbook.Save」の事だとしたら、Workbooks.Open したブックではなく、現在アクティブなブックが対象になってしまいます。これを「.Save」にすれば、Open したそのブックを指し示すようになるかと思います。

あるいは、『処理』というのが「Call test」のことなのだとしたら、test の中身を見てみないと判断できないです。とはいえ、「どのブックを対象に操作するのか」が引数指定されていないことから、曖昧な実装になっていそうな印象があります。

Answer 2

魔界の仮面弁士さん、ご回答を丁寧にありがとうございます。

withを用いないでsetを使うとき、以下のコードで合っているでしょうか？これではできませんでした。(オブジェクト変数またはwithブロック変数が設定されていません)また、参照設定の方をいじってみたら、「システムエラーです。:&H80004005（-2147467259）エラーを特定できません。」と出ました。これはマイクロソフト側のエラーらしいです。

また、「処理」に関しては「Call test」です。With Workbooks.Open(folderPath)では選択したフォルダの内開いているブックを指定できていないでしょうか？Call testはopenしたブックのsheet1に操作しているつもりです。

--------------------------------------------------------------------

Dim bkWork As Workbook '作業用ワークブック
  Dim bkSrc As Workbook 'コピー元ワークブック
  Dim shtIni As Worksheet '初期ワークシート
  Dim folderPath As String '処理対象のフォルダパス
  Dim tmpSinw As Long 'SheetsInNewWorkbook一次記憶用
  Dim tmpDa As Boolean 'DisplayAlerts一次記憶用
  Dim itm As Object
  Dim fd As Object
   
  'Excelファイルが保存されているフォルダを選択
  Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    fd.AllowMultiSelect = False '複数選択しない
    fd.Title = "Excelファイルが保存されているフォルダを選択"
    If fd.Show = True Then
      folderPath = fd.SelectedItems(1) '選択したフォルダのパスを変数に格納
    Else
      Exit Sub 'フォルダが選択されなかった場合は処理終了
    End If

----------------------------------------------------------------------

Call testについて

Sub test ()

Worksheets("Sheet1").Activate

    Range("L2").Value = 1
    Range("L3").Value = 2
    Range("L2:L3").AutoFill Destination:=Range("L2:L30602")

End Sub

どうぞよろしくお願いします。

Answer 3

withを用いないでsetを使うとき、以下のコードで合っているでしょうか？

「Dim fd As Object」も使えますが、今回は「Dim fd As Office.FileDialog」にしてみてください。

もしも「ユーザー定義型は定義されていません。」と表示されてしまうようであれば、参照設定が不足していますので、`Microsoft Office X.X Object Library` への参照を追加しましょう。

これではできませんでした。(オブジェクト変数またはwithブロック変数が設定されていません)

エラーはどの時点で発生していますか?

当初の質問通り、「If fd.Show = True Then」の行を実行した時に発生するのでしょうか。
もしそうなら、実際にダイアログは表示されるのでしょうか、それともダイアログが表示されることなくエラーになるのでしょうか。

ダイアログが表示されるのなら、ダイアログを閉じた後でエラーになるのでしょうか、それともダイアログの表示とエラー出力が一緒に行われるのでしょうか。

また、参照設定の方をいじってみたら、「システムエラーです。:&H80004005（-2147467259）エラーを特定できません。」と出ました。これはマイクロソフト側のエラーらしいです。

参照設定なしで列挙値を指定した場合や、変数の宣言忘れ、あるいはスペルミスなどがそのエラーを引き起こすことがあります。

たとえば、`Microsoft Office X.X Object Library`への参照を含めずに
Dim fd As Object
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
というコードを実行した場合、定数 msoFileDialogFolderPicker への参照を解決できなくなります。

その場合、「Option Explicit」宣言があれば、msoFileDialogFolderPicker が選択されて『変数が定義されていません。』というコンパイルエラーが表示されます。一方、「Option Explicit」宣言が無い場合には、暗黙定義の Variant 変数が自動生成されてしまい、初期値である Empty が引数に渡されたことになり、実行時エラー『'-2147467259 (80004005)'』を引き起こします。

このような事故を防ぐため、モジュールの先頭には常に「Option Explicit」を記入しておくことをお奨めします。

さて、次は Sub test() の話。

Worksheets("Sheet1").Activate

今回は、コードの書いてあるブックとは別に、新しいブックを Open しましたよね。

ですからこのコードだけだと、「どのブックの Sheet1 なのか」が明確になっていないわけです。

Open したブックを対象としたいのであれば、「Sub test(ByVal book As Excel.Workbook)」のように、Workbook 型の引数を追加しておきましょう。そして、「book.Worksheets("Sheet1").Activate」のように呼び出します。

呼び出し側のコードについては、その引数を渡すために、
　Set bk = Workbooks.Open(folderPath)
　test bk    'もしくは「Call test(bk)」
などとします。

Answer 4

ご回答ありがとうございます。

おっしゃる通り、Dim fd as Office.Filedialogで行ってみたところ、できました。ありがとうございます。

option explicitの件ありがとうございます。とても勉強になりました。

Sub testですが、こちらはうまくいきませんでした。ダイアログが出て目的のフォルダを選択し「ok」を選択するとtestの処理が始まり、コードが書いてあるブックのシート1にtestの処理がなされてしまいます。なお、Set bk = Workbooks.Open(folderPath)の部分はitm関数にパスを代入しているため、itm.Pathにしてみました。

どうぞよろしくお願いいたします。

以下現状の全コードになります。

                                                           

Option Explicit

Sub test(ByVal book As Excel.Workbook)

    book.Worksheets("Sheet1").Activate

    Range("L2").Value = 1
    Range("L3").Value = 2
    Range("L2:L3").AutoFill Destination:=Range("L2:L30602")
End Sub

Sub folder_test()

  Dim bkWork As Workbook '作業用ワークブック
  Dim bk As Workbook 'コピー元ワークブック
  Dim shtIni As Worksheet '初期ワークシート
  Dim folderPath As String '処理対象のフォルダパス
  Dim tmpSinw As Long 'SheetsInNewWorkbook一次記憶用
  Dim tmpDa As Boolean 'DisplayAlerts一次記憶用
  Dim itm As Object
  Dim fd As Office.FileDialog

  'Excelファイルが保存されているフォルダを選択
  Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    fd.AllowMultiSelect = False '複数選択しない
    fd.Title = "Excelファイルが保存されているフォルダを選択"
    If fd.Show = True Then
      folderPath = fd.SelectedItems(1) '選択したフォルダのパスを変数に格納
    Else
      Exit Sub 'フォルダが選択されなかった場合は処理終了
    End If

  'ファイルの処理にFileSystemObjectオブジェクトを利用
  With CreateObject("Scripting.FileSystemObject")
    '指定したフォルダ内のファイルを順番に処理
    For Each itm In .GetFolder(folderPath).Files
      '処理対象となるファイルの拡張子を指定
      Select Case LCase(.GetExtensionName(itm.Path))
        Case "xls", "xlsx", "xlsm", "csv"
          'Set bkSrc = Application.Workbooks.Open(itm.Path) 'コピー元のワークブックを開く

          Set bk = Workbooks.Open(itm.Path)
            
            Call test(bk)                                                                                                                                                    
            Application.DisplayAlerts = False   '上書き保存して閉じる
            bk.Save
            bk.Close
            Application.DisplayAlerts = True

      End Select
    Next
  End With

    MsgBox "処理が終了しました", vbInformation

End Sub

Answer 5

book.Worksheets("Sheet1").Activate

Activate や Selection に頼り過ぎないようにしましょう。複数のブックを扱うようなケースで処理が曖昧になってしまうからです。

代わりに、Workbook オブジェクトや Worksheet オブジェクト型の変数を用意して、どのブックのどのシートのどのセルを操作しているのかを明確にします。

Range("L2").Value = 1

たとえば「Range("L2")」ではなく、「book.Worksheets("Sheet1").Range("L2")」や「ThisWorkbook.Worksheets("Sheet1").Range("L2")」などとします。

Answer 6

testの部分を以下のように直してみましたが、やはりコードが書いてあるブックに書き込まれ、選択したフォルダ内のブックには何も起きませんでした。画面はファイルの数だけチカチカするので、ファイル自体は開けていると思うのですが・・・

Sub test(ByVal book As Excel.Workbook)

    book.Worksheets("Sheet1").Activate

    ThisWorkbook.Worksheets("Sheet1").Range("L2").Value = 1
    ThisWorkbook.Worksheets("Sheet1").Range("L3").Value = 2
    ThisWorkbook.Worksheets("Sheet1").Range("L2:L3").AutoFill Destination:=Range("L2:L30602")
End Sub

どうぞよろしくお願いいたします。

Answer 7

ThisWorkbook は、「その VBA コードが書いてあるブック」ですよ?
「Open したブック」を指定したいなら、book 変数の方を使わないと。

Destination:=Range("L2:L30602")

これも NG。ブックやシートが明示されていません。

もしも操作対象が特定のシートに限られるのなら、
Sub test(ByVal book As Excel.Workbook) を
Sub test(ByVal ws As Excel.Worksheet) に変更して、
ブックではなくシートを渡して Call するようにし、
ws.Range("L2:L3").AutoFill Destination:=ws.Range("L2:L30602")
のようにします。

Answer 8

ご回答ありがとうございます。

ThisWorkbook は、「その VBA コードが書いてあるブック」ですよ?
「Open したブック」を指定したいなら、book 変数の方を使わないと。

確かにそうでした。book変数で行ったところ、できました。

悩みがやっと晴れました、ありがとうございます！

大変丁寧な説明でとても分かりやすかったです、ありがとうございました。

Answer 9

同じ表題・同じ内容のスレッドを 2 つ立ててますが、スレッドの乱立は止めてください。

2020年8月15日 5:56

https://social.msdn.microsoft.com/Forums/ja-JP/34f3add1-74ce-4561-a275-ad6254acc11c/12501124571252312480123981249712473214622447112392122891250112?forum=vbajp&prof=required

2020年8月17日 3:18

https://social.msdn.microsoft.com/Forums/ja-JP/cfcf1b76-f5bf-4204-855c-e8d92eb79862/12501124571252312480123981249712473214622447112392122891250112?forum=vbajp

前者はレスをもらっておきながら何もフィードバックせず放置状態。マナー的にどうかと思いますけど。

後者のスレッドのやり取りで解決したようですが、であればクローズしてください。それもマナーです。

Microsoft の管理者の方へ＞

統合するなど処置をお願いします。

Answer 10

ご指摘ありがとうございます。

Answer 11

後者のスレッドのやり取りで解決したようですが、であればクローズしてください・・・とお願いしましたが？

解決に役に立った回答には「回答としてマーク」をつけてください（複数可）。

Answer 12

回答がすでになされているため、削除できません。ヘルプで確認してください。

Why am I unable to delete my post?

You will not be able to delete your post if:

• You have not signed in to Forums.
• Somebody has already replied to your post.
• The post has been marked as an answer or proposed answer.