質問です

c:\test\のホルダーの中に複数のCSVファイルがあります
そのファイル名の頭に連番を01-から順番にファイルの数分だけ
上から下の並び順に番号をつけたいのですが(最後は数字てきには99-となります)
マクロでお願いします。
最初は以下の状態です
aaaa.csv
bbbb.csv
cccc.csv
連番を付けると以下の状態です半角番号と-の半角です
01-aaaa.csv
02-bbbb.csv
03-cccc.csv
以下ファイルの数の分の連番です

回答の条件
  • 1人3回まで
  • 13歳以上
  • 登録:2012/05/10 09:56:13
  • 終了:2012/05/10 11:17:14

ベストアンサー

id:taknt No.1

きゃづみぃ回答回数13539ベストアンサー獲得回数11982012/05/10 10:28:56

ポイント100pt
'
'ツール → 参照設定で Microsoft ActiveX Data Objects *.* Library にチェックを入れておいて下さい

'


Sub main()
Dim p As String
'対象フォルダを指定してください。
'このフォルダに この実行用のブックは 入れないでください。

p = "C:\test\"

'処理対象となる拡張子を指定して 呼び出します。
Call jikkou(p, "csv")

End Sub


Sub jikkou(p As String, s As String)
    
    'Recordsetを作成
    Dim RS As ADODB.Recordset
    Set RS = New ADODB.Recordset
    RS.Fields.Append "Name", adVarWChar, 256
    RS.Fields.Append "Date", adDate
    RS.Fields.Append "Size", adInteger
    RS.Open

    'データを格納
    Dim Path As String
    Path = Dir(p & "*." & s)
    Do Until Path = ""
        RS.AddNew "Name", Path
        RS.Update
        Path = Dir()
    Loop


    If RS.RecordCount = 0 Then
        MsgBox "該当データなし"
        RS.Close
        Set RS = Nothing
        Exit Sub
    End If

    'ソート
    RS.Sort = "Name"            'ファイル名順
    RS.MoveFirst

    '表示
    k = 1
    Do Until RS.EOF
        a = Right("0" & Trim(Str(k)), 2) & "-"
        Name p & RS.Collect("Name") As p & a & RS.Collect("Name")
        k = k + 1
        If k > 99 Then Exit Do
        RS.MoveNext
    Loop

    RS.Close
    Set RS = Nothing

End Sub


実行する前に
ツール → 参照設定で Microsoft ActiveX Data Objects *.* Library にチェックを入れておいて下さい。

バージョンは 一番 大きいものでいいです。

他2件のコメントを見る
id:taknt

この ソースを 貼りつけるウィンドウのバーに ツールって ないでしょうか?

2012/05/10 11:04:05
id:inosisi4141

わかりましたありがとうございました
早速実行しましたら上手くいきましたありがとうございました
大変たすかりました今後ともよろしくおねがいします。

2012/05/10 11:17:04

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません