[[20220228125735]]　『大量のCSVファイルのA1セルにブック名を入力して普x（さちよ）　ページの最後に飛ぶ

『大量のCSVファイルのA1セルにブック名を入力して保存したい』（さちよ）

はじめまして

　1つのフォルダーに１００以上のCSVファイルがあります。
　次のステップの前処理として、フォルダー内のすべてのファイルのA1セルに
　ブック名を入力し保存したいと考えています。

　単独の通常の.xlsxファイルであれば以下のマクロで動くことは確認しています（スマートではないかもですが。確認アラートは全て出さない）

Sub セル_A1_に拡張子抜きのブック名を入力後に保存()

    Dim bookname As String
    Dim new_file As Variant
    bookname = ActiveWorkbook.Name
    Range("A1").Value = _
        "'" & Left(bookname, InStrRev(bookname, ".") - 1)

    new_file = ActiveSheet.Name
    'csvファイルとして保存する
    Application.DisplayAlerts = False 
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & new_file & ".csv", _
    FileFormat:=xlCSV, CreateBackup:=False
    ActiveWorkbook.Close
End Sub

同じフォルダー内に処理用のマクロブックを置き
そのファイルからマクロを実行して、フォルダー内のすべてのCSVファイルのA1セルにブック名を入れて保存するにはどのようにすればよろしいでしょうか？

教えていただけないでしょうか。

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

 意味が違ったらすみません。

 Sub SAMPLE()
    Dim FSO As Object
    Dim targetFile
    Dim targetFilePath As String
    Dim csvFile
    Dim Data As String
    Dim fileName As String
    Set FSO = CreateObject("Scripting.FileSystemObject")
    For Each targetFile In FSO.GetFolder("対象フォルダのパス").Files
        If FSO.GetExtensionName(targetFile) = "csv" Then
            targetFilePath = targetFile.Path
            Set csvFile = FSO.OpenTextFile(targetFilePath)
            Data = csvFile.ReadAll
            csvFile.Close
            FSO.DeleteFile targetFile
            Set csvFile = FSO.OpenTextFile(targetFilePath, 2, 1)
            csvFile.WriteLine FSO.GetBaseName(targetFilePath)
            csvFile.WriteLine Data
            csvFile.Close
        End If
    Next targetFile
 End Sub
（通りすがり） 2022/02/28(月) 13:54

通りすがり様

マクロの提示ありがとうございます。
確認させていただきました。

これを実行したところ、1行挿入してからA1にブック名が書き込まれるようになります。

A1セルに上書きだけで、行を挿入しないようにできるのでしょうか？

よろしくお願いいたします。

（さちよ） 2022/02/28(月) 16:21

 参考に
 Sub Test()
    Dim FSO As Object
    Dim fl As Object, f As Object
    Dim buf As Variant, buf2 As Variant

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set fl = FSO.GetFolder(ThisWorkbook.Path)
    For Each f In fl.Files
        If FSO.GetExtensionName(f) = "csv" Then
            With FSO.OpenTextFile(f, 1)
                buf = .ReadAll
                .Close
            End With
            buf = Split(buf, vbCrLf)
            buf2 = Split(buf(0), ",")
            buf2(0) = FSO.GetBaseName(f)
            buf(0) = Join(buf2, ",")
            buf = Join(buf, vbCrLf)
            With FSO.OpenTextFile(f, 2)
                .Write buf
                .Close
            End With
        End If
    Next
    Set FSO = Nothing
 End Sub

（ピンク） 2022/02/28(月) 19:59

世の中にはこんな感じのくそったれなCSVファイルもあるので気が抜けません

"A,B","C","D"
"E","F,G","H"

実際のCSVファイルの1行目を何例か書き込んだ方がいいですよ
（あのにます） 2022/02/28(月) 22:00

＞次のステップの前処理として、フォルダー内のすべてのファイルのA1セルに
＞ブック名を入力し保存したいと考えています。
普通は一行目には項目見出しがあると思いますが、それが崩れてしまわないのですか？
A列には何が入っているのですか？
その項目の見出しに、それぞれのファイル名を入れて問題ないのですか？
　
次のステップにどんなことをするのか知りませんが、
いずれCSVを開くときにファイル名は手に入れるじゃないですか？
　
CSVファイルの中にファイル名がないとダメなものなんですか？
そのあたりが良くわからなかったですね。
（γ） 2022/02/28(月) 23:29

ピンク様

　ありがとうございます。私の拙い文章を読み解き、ありがとうござました。
当初希望した内容が反映されており、素晴らしいです。さすがです。
色々調べて、
GetFolder
GetBaseNameを使うことができるなと思っておりました。
その間に、GetExtensionNameをつかうのですね。

あのにます様
　ありがとうございます。幸い、私の使うCSVファイルは単純に数字の昇順でネーミングされています。

＞実際のCSVファイルの1行目を何例か書き込んだ方がいいですよ
失礼しました。

1行目は全て日本語です。
順番、名前、性別、生年月日、身長、体重、・・・・・といった感じです。

Y様
　ありがとうございます。
A1にはすべて‘順番’という文字が入っていますが、次のステップでは不要な文字列になります。
私の実力ではA1セルにファイル名（昇順の数字で構成）を使い抽出できると簡単と考え、マクロを書き
CSVファイルのA1セルに毎回数字を手打ちしておりました。

本来ならば、ファイル名を抽出するマクロを次の処理に入れ込めばよかったのですが、難しかったので・・
（さちよ） 2022/03/01(火) 09:52

そうでしたか。説明ありがとうございます。

＞ファイル名を抽出するマクロを次の処理に入れ込めばよかったのですが、難しかったので
ファイルは必須の情報なので、開くためにファイル（パス）を必ず手に入れます。
今となっては、
＞GetBaseNameを使うことができるなと思っておりました。
とすればよいですね。
（順番は、クラス内の一意化の番号ではないんですか？使わないのですか？）
# 回答不要です。

（γ） 2022/03/01(火) 11:39

コメント返信：

[ 一覧(最新更新順) ]

[[20220228125735]] 『大量のCSVファイルのA1セルにブック名を入力して普x（さちよ） ページの最後に飛ぶ

[[20220228125735]]　『大量のCSVファイルのA1セルにブック名を入力して普x（さちよ）　ページの最後に飛ぶ