【VBA】指定フォルダに格納中のテキストファイルをエクセルで処理し結果のエクセルを新規フォルダに保存

こんにちは。

エクセルにて連番のテキストファイルを読込/処理し、それぞれの結果を新規作成したフォルダに保存するようにしたいのですが、コードを教えていただけますでしょうか？

イメージは以下のような感じです。
・元データ
　フォルダ名 ：A
　格納テキストファイル：file_000.txt　～file_500.txt
　ファイルの中身：1列　20行の文字データ

・処理したい内容
　１．元データのあるフォルダAと新規作成フォルダBをセルで指定
　２．フォルダA直下にフォルダBを作成
　３．エクセルへfile_00.txtのデータを読込、特定セルへ貼り付け
　４．20行のデータを上から順に結合　※結果は特定セル(例：A1セル)に格納
　５．５のセルの値をフォルダB(ファイル名は読込ファイルと同一)へ格納
　６．４の変換処理をテキストデータ分繰返し

やりたいことはわかるのですが、上手くコードにすることができず、ご助力頂けると助かります。

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

• 

  テキストファイルの中身(1列20行)はこんなイメージです。
  
  あい
  じく
  あお
  　・
  　・
  そら
  
  このようなデータが20行あります。
  エクセルで処理後のセル：あいじくあお・・・そら

    補足日時：2022/03/25 14:24

No.1 ベストアンサー 回答者： fujillin 回答日時： 2022/03/25 16:52

こんにちは

＞やりたいことはわかるのですが、上手くコードにすることができず
ご本人はなさりたいことがわかっているのでしょうけれど、説明が抽象的なのでコードにしようがありません。

以下は、『指定フォルダA内のテキストファイルの20行目迄を1行にまとめ、指定フォルダA内の指定フォルダBに作成する』という基本的なコードです。
不明点ばかりなので、適当に固定指定と決め打ちの処理にしてあります。

Sub Q12866922()
Dim fs, file, ts
Dim str As String
Dim FA As String, FB As String

Const フォルダA = "C:\Users\hogehoge\フォルダA"
Const フォルダB = "フォルダB"

Set fs = CreateObject("Scripting.FileSystemObject")
FA = フォルダA
FB = FA & "\" & フォルダB
If Not fs.FolderExists(FA) Then
MsgBox "指定フォルダが見つかりません"
Exit Sub
End If
If Not fs.FolderExists(FB) Then fs.CreateFolder FB

For Each file In fs.GetFolder(FA).files
If LCase(fs.GetExtensionName(file)) = "txt" Then
str = ""
Set ts = fs.OpenTextFile(FA & "\" & file.Name, 1)
Do While Not ts.AtEndOfLine And ts.Line < 21
str = str & ts.ReadLine
Loop
ts.Close
Set ts = fs.CreateTextFile(FB & "\" & file.Name, 1)
ts.WriteLine (str)
ts.Close
End If
Next file
End Sub

※ まずはそのままで処理を確認できたなら、なさりたいように修正してください。

この回答へのお礼

回答いただきありがとうございます。いただいたコードを参考にトライしてみます。

お礼日時：2022/03/25 17:19