【VBA】フォルダ配下の複数のテキストファイルから、別シートにデータを抽出するやり方を教えて下さい

はじめまして。
都内でシステム構築をおこなっているものです
エクセルでテキストデータを抽出するツールマクロ作成を急遽依頼されたのですが
VBAは初心者のため自分でこのようなものを作ることができません。
どうかお知恵をおかしください。

マクロの動作としては
実行後、B4セル(Book_A)にかかれた
フォルダのパス(仮に"D:\data\")から

下記のテキストファイルを読み込みます。

A_*.txtデータ
B_*.txtデータ
C_*.txtデータ


その後テキストファイルの内容を
下記のデータシート(Book_B)
に一行づつ書き出したいです。
書き出すシートはそれぞれ

sheets("Aデータシート")→　A_*.txtデータ
sheets("Bデータシート")→　B_*.txtデータ
sheets("Cデータシート")→ C_*.txtデータ　
となっています。


上記内容になりますが、どうかよろしくお願いいたします。

質問者からの補足コメント

• 

  ご回答ありがとうございます。
  
  ご指摘の通り、ブックは２つあり、同じフォルダに格納してあります。
  VBAコードを書くブックブック→（Book_A.xlsm）
  データシートに書き込むブック→（Book_B.xlsx）
  A_*.txtデータ、B_*.txtデータ、C_*.txtデータの"*"の記載に関しては
  こちらの確認ミスですが、ファイル名はすべて一定だったため配列インデックス
  で問題ありません。失礼しました。
  追加の質問で申し訳ないのですが
  データシートに書き込んだB_Bookはできれば新規で保存したい
  です。今のところVBAコードで読み取り専用で開いているのですが
  この方法だと手動で保存しないといけないため、できれば
  （Book_B.xlsm）のあるフォルダに自動で保存する方法を教えて頂けたらで幸いです。

  No.2の回答に寄せられた補足コメントです。 補足日時：2020/02/17 01:41

• 

  ご回答していただきありがとうございます。
  検証した結果、ファイル内容をBook_B.xlsxのデータシートに書き出すことができました。
  データシートに出力する際、Book_B.xlsxの参照パスは、(ThisWorkbook.Path)だと
  何故か個人マクロブックのファイルパスを参照したためActivebookに変更しましが
  それ以外はデータシートへの出力も新規のブックでの保存もできました。
  ただ、テキストファイルの出力方法をtxtデータによって変えてほしいとお話があり…、
  たびたび追加で質問して申し訳ないのですが、
  
  C_*.txtデータのみ別で、末尾まで読み込んだデータを、
  LFで区切って1行ずつのデータとしてCデータシートに書き出せないでしょうか。

  No.3の回答に寄せられた補足コメントです。 補足日時：2020/02/18 01:24

No.4 回答者： Qchan1962 回答日時： 2020/02/18 02:11

こんばんは、言葉の綾かも知れませんが、

ご質問（表題の件）については、質問の不備の調整を含め、すでに回答済みです。
作成を受けた覚えはないので、追加質問に関しては、ご自身でやってください。
回答への返信などを見る限り、その程度のスキルは御有りだと思います。

あなたが、依頼されたと言う事は、プロなのでしょうから、、がっかりさせないでください。
それとも改めて私に依頼されますか？すでに回答している部分だけでも、あなたならいくら取りますか？
こんな事、書きたくはありませんので、
必要であれば、新たに質問スレッドを建てるなどして、気持ち良く終わらせた方が良いと思いますよ。

この回答へのお礼

ご回答ありがとうございました。
急ぎだったため、追加質問してしまい失礼しました。記述していただいた内容を参考に、あとは自力で作成します。

お礼日時：2020/02/18 08:10

No.3 回答者： Qchan1962 回答日時： 2020/02/17 02:40

Sub Test_txt_inBook()　部分を改めて投稿します。

新規ブック名は、コメント部で変更してください。現行：日付+Book_B.xlsx　です。
マクロ有効ブックにする場合、"Book_B.xlsx"を"Book_B.xlsm" 　.SaveAs New_fileNameを下記のようにします。
.SaveAs New_fileName,FileFormat:=xlOpenXMLWorkbookMacroEnabled

基本的な処理は、問題がなかったのでしょか？
一応、他ブックを弄ったりするので、制御系を追加しました。

Sub Test_txt_inBook()
Dim i As Long
Dim TxtPath As String: TxtPath = Workbooks("Book_A.xlsm").Sheets(1).Cells(4, 2).Value　　'"D:\data\"
Dim FileName As Variant: FileName = Array("A_*.txt", "B_*.txt", "C_*.txt")
Dim TgtSht_Name As Variant: TgtSht_Name = Array("Aデータシート", "Bデータシート", "Cデータシート")
Dim Book_B As String: Book_B = "Book_B.xlsx"
Dim TgtSht As Worksheet, strFileName As String
　　For i = 0 To UBound(FileName)
　　　　strFileName = Dir$(TxtPath & "\" & FileName(i))
　　　　If strFileName = "" Then
　　　　　　MsgBox (FileName(i) & "データが見つかりません。" & vbCrLf & "保存されているか確認してください")
　　　　　　Exit Sub
　　　　End If
　　Next
　　If Dir(ThisWorkbook.Path & "\" & Book_B) <> "" Then
　　　　With Application
　　　　　　.ScreenUpdating = False
　　　　　　.DisplayAlerts = False
　　　　　　.Calculation = xlCalculationManual
　　　　End With
　　　　With Workbooks.Open(ThisWorkbook.Path & "\" & Book_B)
　　　　　　For i = 0 To UBound(TgtSht_Name)
　　　　　　　　For Each TgtSht In ActiveWorkbook.Worksheets
　　　　　　　　　　If TgtSht.Name = TgtSht_Name(i) Then
　　　　　　　　　　　　Call Txt_Import(TxtPath, FileName(i), TgtSht)
　　　　　　　　　　　　Exit For
　　　　　　　　　　End If
　　　　　　　　Next
　　　　　　Next i
　　　　　　Dim New_fileName As String
　　　　　　New_fileName = ThisWorkbook.Path & "\" & _
　　　　　　　　　　　　　 Format(Date, "yyyymmdd") & "Book_B.xlsx" 'ここで新規ブック名を指定してください
　　　　　　.SaveAs New_fileName
　　　　　　.Close
　　　　End With
　　End If
　　With Application
　　　　.Calculation = xlCalculationAutomatic
　　　　.DisplayAlerts = True
　　　　.ScreenUpdating = True
　　End With
　　MsgBox ("完了")
End Sub

Sub Txt_Import(TxtPath As String, FileName As Variant, TgtSht As Worksheet)　テキストファイル抽出部はそのままで

No.2 回答者： Qchan1962 回答日時： 2020/02/16 10:24

おはようございます。

ご質問を読むとVBAで触るブックが2つあると思います。
しかし、Book_Aは、フォルダのパスを指定するのみの扱いになっている事から、
VBAコードを書くブックは、Book_Aでも、良さそうですね。
また、違う　別のVBAブックに書いてもBook_Aを開いた状態なら、実行できるようにすれば良さそうです。

また、Book_Bについては、フォルダのパスの指定がないので、VBA実行Bookと同じパス（ThisWorkbook.Path）でコードを書きます。
＞VBAは
他の言語の知識があると想定し、デバッグや補足で対応した方が早いと思ましたので見切りで

簡単な説明は、最後に加えます。

’---
Option Explicit
Sub Test_txt_inBook()
Dim i As Long
Dim TxtPath As String: TxtPath = Workbooks("Book_A.xlsm").Sheets(1).Cells(4, 2).Value　　'"D:\data\"
Dim FileName As Variant: FileName = Array("A_*.txt", "B_*.txt", "C_*.txt")
Dim TgtSht_Name As Variant: TgtSht_Name = Array("Aデータシート", "Bデータシート", "Cデータシート")
Dim Book_B As String: Book_B = "Book_B.xlsx"
Dim TgtSht As Worksheet, strFileName As String

　　For i = 0 To UBound(FileName)
　　　　strFileName = Dir$(TxtPath & "\" & FileName(i))
　　　　If strFileName = "" Then
　　　　　　MsgBox (FileName(i) & "データが見つかりません。" & vbCrLf & "保存されているか確認してください")
　　　　　　Exit Sub
　　　　End If
　　Next
　　If Dir(ThisWorkbook.Path & "\" & Book_B) <> "" Then
　　　　With Workbooks.Open(ThisWorkbook.Path & "\" & Book_B)
　　　　　　For i = 0 To UBound(TgtSht_Name)
　　　　　　　　For Each TgtSht In ActiveWorkbook.Worksheets
　　　　　　　　　　If TgtSht.Name = TgtSht_Name(i) Then
　　　　　　　　　　　　Call Txt_Import(TxtPath, FileName(i), TgtSht)
　　　　　　　　　　　　Exit For
　　　　　　　　　　End If
　　　　　　　　Next
　　　　　　Next i
　　'　　　　　　　　.Save
　　'　　　　　　　　.Close
　　　　End With
　　End If
End Sub

Sub Txt_Import(TxtPath As String, FileName As Variant, TgtSht As Worksheet)
Dim Fn As Integer: Fn = FreeFile
Dim n As Long, buf As String
Dim strFile As String
　　strFile = Dir(TxtPath & "\" & FileName)
　　Open TxtPath & "\" & strFile For Input As #Fn
　　n = TgtSht.Cells(Rows.Count, 1).End(xlUp).Row
　　Do Until EOF(1)
　　　　Line Input #Fn, buf
　　　　n = n + 1
　　　　TgtSht.Cells(n, 1) = buf
　　Loop
　　Close #Fn
End Sub

’----

Book_Aブックもしくは、操作外のブック標準モジュールへ
Book_Aブック以外のブックにVBAコードを書き実行する場合は、Book_Aブックをあらかじめ開いておく必要があります。念のため開いているか確認するプロセスを追加してください。
TxtPath As String: TxtPath = Workbooks("Book_A").Sheets(1).Cells(4, 2).Value　　’Sheets(1)は、一番左のシート、、TxtPath = "D:\data\" テスト時であれば直接でも良い

先ず初めに、テキストファイルが指定パスに存在するかを確認しています。
途中でやると面倒なので、、この辺りは、無ければ次みたいにした方が良いのかも知れません。仕様によりますが。
また、この他のエラー対策は行っておりませんので必要に応じ追加してください。

sheets("Aデータシート")→　A_*.txtデータ
sheets("Bデータシート")→　B_*.txtデータ
sheets("Cデータシート")→ C_*.txtデータ　

は、配列インデックスで対応しましたが、*　が気になります。複数あると言う事か、、？実際の仕様ではどうでしょうか？
また、すべてのテキストデータを対象にする場合など、配列に入れる方法を工夫する必要があるかも知れません。（プロセス自体の変更も）
Dim FileName As Variant: FileName = Array("A_*.txt", "B_*.txt", "C_*.txt")は
Dim FileName As Variant
FileName = Array("A_*.txt", "B_*.txt", "C_*.txt")


テキストファイルを操作する部分をサブスクリプトにしました。
Sub Txt_Import(TxtPath As String, FileName As Variant, TgtSht As Worksheet)

テキストファイルを開いてブックのシートにラインベースで書き込みます。
必要な要素はこの場合、ファイルパス、ファイル名、書き込み先シート名

ブックについては、With Workbooks.Openでアクティブになっているブックです。

Book_BをVBAで開いていますが、保存して閉じるなどは確認の為、コメントアウトしています。
　　'　　　　　　　　.Save
　　'　　　　　　　　.Close

コードを書くよりテスト環境を作る方が、面倒、、（検証済み）

想定、仕様から大きく離れていなければ、良いのですが、、。

No.1 回答者： GooUserラック 回答日時： 2020/02/16 01:45

☆「Book_A」と「Book_B」とマクロを書き込むファイルの置いてある位置関係は次のどれでしょうか？

　① マクロのファイルと同じパス
　② それぞれ違うパス（それぞれのパスをご提示ください）
　③ その他（具体的に説明して下さい）
☆「Book_A」と「Book_B」とマクロを書き込むファイルの拡張子は次のどれでしょうか？
　④「Book_A」と「Book_B」は「.xlsx」、マクロを書き込むファイルは「.xlsm」
　⑤ 全て「.xls」
　⑥「Book_A」と「Book_B」は「.xls」、マクロを書き込むファイルは「.xlsm」
　⑦ その他（具体的に説明して下さい）
☆ データはＡ列だけに追加書き込みすれば良いのでしょうか？