[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『フォルダ作成時に連番数字をつける』（ゆうき）
初めまして。質問させてください。
指定パス内には、フォルダ名の頭に”0001”と数字を振ったフォルダを作成したいです。
フォルダ名の構成としては、
”0001_○○”となるようにしたいです。
Dim A As String, B As String, kyo As String
A = InputBox("フォルダパスを入力", "", "")
kyo = Range("F" & ActiveCell.Row)
B = A & "\" & "0001_" & kyo
If Dir(B, vbDirectory) = "" Then
MkDir B
End If
パスを指定し、vbaを入れたワークブックのアクティブセルのF列にある値をkyoに入れて、0001_kyoのフォルダを作成することは成功しました。
ここから、次にこのフォルダ内にフォルダを作成する場合に
0002、0003・・・と頭の数字を連番にしたいのですが、どのようなコードが必要でしょうか？
教えて頂けると大変助かります。
＜ 使用 Excel：Excel2016、使用 OS：Windows10 ＞
こんな感じじゃないでしょうか？
Sub test()
Dim A As String, B As String, kyo As String
Dim i As Long
A = InputBox("フォルダパスを入力", "", "")
kyo = Range("F" & ActiveCell.Row)
For i = 1 To 10 '<-ここの値を造りたい数だけ書き換える
B = A & "\" & Format$(i, "0000_") & kyo
If Dir(B, vbDirectory) = "" Then
MkDir B
End If
Next i
End Sub
（稲葉） 2023/02/03(金) 11:34:09
＞次にこのフォルダ内にフォルダを作成する
とは、一連の作業ではなく、たとえば別の日にマクロを動作させた時という意味だったりしませんか？
どちらもYESなら、
1. 配下にある全部のフォルダ名を調べ、先頭4文字から【数値】をとりだす。 2. ↑の中から最大値を調べる 3. ↑に+1した【数字】を頭にくっつけてフォルダを作成する
となるとおもいます。
（もこな２） 2023/02/03(金) 12:29:41
もこな２さん
回答ありがとうございます！
どちらもYESです。
すべてのフォルダ名をエクセルのどこかに書き出し、隣のセルにLEFT関数で先頭4文字を取り出し、並べ替えて最大値を取得。最大値に+1したフォルダを作成する。という感じのことでしょうか。
コード調べながらやってみます。ありがとうございます！
（ゆうき） 2023/02/03(金) 13:25:44
なるほど。
毎日？実行して、都度加算するわけっすね。
こんな感じでフォルダ一覧取得して、0000_kyoの形のフォルダだけ調べて最大値を取得ってのはどうでしょう？
Sub test()
Dim A As String, B As String, kyo As String
Dim i As Long
A = InputBox("フォルダパスを入力", "", "")
kyo = Range("F" & ActiveCell.Row)
B = A & "\" & Format$(LastNum(A, kyo) + 1, "0000_") & kyo
MkDir B
End Sub
Function LastNum(fp As String, dName As String) As Long
Dim cmd As String
Dim tmpDirectory As Variant
Dim i As Long
Dim m As Object
Dim intMax As Long
Dim tmpCnt As Long
Dim reg As Object: Set reg = CreateObject("VBScript.Regexp")
reg.Global = True
reg.Pattern = "([0-9]{4})_" & dName
'[指定フォルダ内のフォルダ一覧を取得]
With CreateObject("WScript.Shell")
cmd = "cmd /C dir /A:d /B ""■"""
cmd = Replace(cmd, "■", fp)
tmpDirectory = Split(.exec(cmd).stdout().readall(), vbCrLf)
End With
'
'[正規表現で一致するフォルダ名を取得し、最大値を調べる]
intMax = 0
For i = 0 To UBound(tmpDirectory)
Set m = reg.Execute(tmpDirectory(i))
If m.Count > 0 Then
tmpCnt = 0
tmpCnt = CLng(m(0).submatches(0))
If intMax < tmpCnt Then
intMax = tmpCnt
End If
End If
Next i
LastNum = intMax
End Function
（稲葉） 2023/02/03(金) 14:45:43
昔、同じようなことを考えたのを思い出しました。
そのときは稲葉さんのコードで
「B = A & "\" & Format$(i, "0000_") & kyo」
をテンポラリセルに文字列として作成し、
マクロはテンポラリのディレクトリを作成するようにしていました。
For文は不要となり
「B = A & "\" & Format$(Row() ± α, "0000_") & kyo」
を関数にする感じですかね。
マクロの用途、使用頻度等が読み取れませんでしたが
今日、0001〜0010を作ったとして
翌日以降？次回から毎回マクロを修正するよりは
セルの値や式を変えるほうが汎用的かと思い、
しゃしゃり出てしまいました。
失礼しました。
（初心者） 2023/02/03(金) 15:04:04
C:\Users\Hoge\デスクトップ\てすと
├0001_いろは └0002_にほへ
↓処理後
C:\Users\Hoge\デスクトップ\てすと ├0001_いろは ├0002_にほへ └0003_とちり
という処理をしたいのであれば、先に述べたように
1. フォルダ名を調べ、先頭4文字から【数値】をとりだす。
（上記の例でいえば、1,2という数値が取り出される）
2. ↑の中から最大値を調べる
（上記の例でいえば、2が該当）
3. ↑に1を加算してフォルダ名の先頭にくっつける
（上記の例でいえば、2+1が3になるから"0003_"を先頭にくっつけてフォルダを作成する）
というようにすればよいから、例えば↓のような感じにしてみてはどうでしょうか。
Sub 実験()
Dim ルートフォルダ As String
Dim 配列() As Long
Dim i As Long
Dim フォルダ名 As String
Dim MyFolder As Object
ルートフォルダ = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\てすと\"
Stop 'ブレークポイントの代わり
For Each MyFolder In CreateObject("Scripting.FileSystemObject").GetFolder(ルートフォルダ).SubFolders
ReDim Preserve 配列(i) As Long
配列(i) = Left(MyFolder.Name, 4)
Debug.Print MyFolder.Name & " → "; 配列(i)
i = i + 1
Next MyFolder
MkDir ルートフォルダ & Format(WorksheetFunction.Max(配列) + 1, "0000_") & "とちり"
End Sub
※もちろん発案されたようにワークシートを使って↓のようにしてもＯＫだとおもいます。
すべてのフォルダ名をエクセルのどこかに書き出し、 隣のセルにLEFT関数で先頭4文字を取り出し 【ワークシートのMAX関数で】最大値を取得。 最大値に+1した【数値をFormat関数で桁埋めして、該当の】フォルダを作成する。
（もこな２） 2023/02/03(金) 15:20:36
C:\Users\Hoge\デスクトップ\てすと ├0001_いろは └0002_にほへ ↓処理後 C:\Users\Hoge\デスクトップ\てすと ├0001_いろは ├0002_いろは └0002_にほへ こうだと思ってた・・・ （稲葉） 2023/02/03(金) 16:01:28
Sub 実験2()
Dim ルートフォルダ As String, フォルダ名 As String
Dim i As Long
ルートフォルダ = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\てすと\"
フォルダ名 = "いろは"
For i = 1 To 9999
If Dir(ルートフォルダ & Format(i, "0000_") & フォルダ名, vbDirectory) = "" Then Exit For
Next i
If i <= 9999 Then
MkDir ルートフォルダ & Format(i, "0000_") & フォルダ名
Else
MsgBox "指定のフォルダは9999番まで使い切りました"
End If
End Sub
（もこな２） 2023/02/03(金) 18:26:25
採番部分だけですけど、こんな感じでしょうか
Sub sample() Dim Path As String Path = "D:\test" Debug.Print NextNumber(Path, "*") ' 全体の通し番号ならこちら Debug.Print NextNumber(Path, "いろは") ' 名前ごとの通し番号ならこちら End Sub
Function NextNumber(Path As String, name As String)
Dim d As String, num As Long, maxnum As Long
d = Dir(Path & "\????_" & name, vbDirectory)
Do While d <> ""
num = Val(Left(d, 4))
If num > maxnum Then maxnum = num
d = Dir
Loop
NextNumber = maxnum + 1
End Function
（´・ω・`） 2023/02/03(金) 18:40:25
こうですか？
Sub sample() Dim Path As String, kyo As String Path = "D:\test" kyo = "いろは" Debug.Print NextNumber(Path, "*") & kyo ' 全体の通し番号ならこちら Debug.Print NextNumber(Path, kyo) & kyo ' 名前ごとの通し番号ならこちら
End Sub
Function NextNumber(Path As String, name As String) As String
Dim d As String, num As Long, maxnum As Long
d = Dir(Path & "\????_" & name, vbDirectory)
Do While d <> ""
num = Val(Left(d, 4))
If num > maxnum Then maxnum = num
d = Dir
Loop
NextNumber = Format(maxnum + 1, "0000_")
End Function
（´・ω・`） 2023/02/03(金) 18:43:31
自分でやるなら、（もこな２） 2023/02/03(金) 18:26:25さんのコード作りますね、きっと。 正規表現はWScriptのDirはDirectoryにワイルドカードできなくて苦肉の策でございました。
（´・ω・`）さん VBAのDirだと「Path & "\????_" & name」で行けるんですね・・・最初に試せばよかった・・・ （稲葉） 2023/02/03(金) 18:46:36
Function LastNum(fp As String, dName As String) As Long
Dim cmd As String, s
cmd = "cmd /c dir """ & fp & "\*_" & dName & """ /b/ad/o-n"
s = Split(CreateObject("wscript.shell").exec(cmd).stdout.readall, vbCrLf)
If uboud(s) > -1 Then
LastNum = Val(s(0))
End If
End Function
（マナ） 2023/02/03(金) 19:35:17
なるほど・・・その手がありましたか。
そういえば日付ネタで同じような発想があったような気がします。（どの記事だったかは忘れましたが）
お目汚し失礼しました。
（もこな２） 2023/02/03(金) 19:42:23
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.