Excelで、表を作成したいのですが…

質問

データの整理を、各フォルダに 個人・団体名と、会員番号をつけて登録月日の順で表を作っていました
しかし、先日 HDが壊れたため　Excelのシートが消えてしまいました

データの入ったドライブは無事だったので、
　[フォルダ名をコピー]⇒[セルに貼付け]
を繰り返せば同じシートが作成できます
この作業を簡単なマクロで自動化する方法はないでしょうか

約1000件分なので時間を掛ければ何とかなるとは思いますが、他にも消失したデータがあり困っています

どうか、よろしくお願いします//

回答No.1

marbin · ベストアンサー

フリーウェアでテキストファイルやエクセルに書き出すものもあると
思いますが、
エクセルVBAのダイアログで選択したフォルダ内のサブフォルダ一覧
をセルに書き出すサンプルコードです。

Sub getsubfol()
Dim oya As String
Dim fol As String
Dim i As Long
Dim obj As Object
Dim myobj As Object
Set obj = CreateObject("Shell.Application")
Set myobj = obj.BrowseForFolder(0, "選択して下さい。", 0)
If myobj Is Nothing Then Exit Sub
oya = myobj.Items.Item.Path & "\"
fol = Dir(oya, vbDirectory)
Do While fol <> ""
If (GetAttr(oya & fol) And vbDirectory) = vbDirectory Then
If Not fol Like ".*" Then
i = i + 1
Worksheets(1).Cells(i, 1).Value = fol
End If
End If
fol = Dir()
Loop
End Sub

お礼

早速の回答、ありがとうございます

こんな数分で、作成できるコードなんですね
自分の不勉強を棚に上げる様で申し訳ありませんが、うまく貼付いてくれました
非常に助かりました、ありがとうございます　//

回答No.2

zap35

フォルダの構成がどのようになっているか分からないので１００％満足できる方法ではないと思いますが、Windowsのコマンド画面で
>DIR ドライブ番号:\フォルダ名 > d:\DIR.TXT
と入力すると、指定したフォルダのファイル一覧（サブフォルダ名も）がテキストファイルになります。

これをEXCELで開くとフォルダ名をセルに貼りつけるよりは楽に作業できませんか？　テキストファイルウィザード1/3で「カンマやタブなどの…」を選択し、ウィザード2/3でスペースを区切り文字として選択してください。

サブフォルダは　<DIR>　という識別が入っていますので、その列でオートフィルタをかければサブフォルダ名だけ取得できます。

お礼

丁寧な回答、ありがとうございます

最初に、WinＸＰのコマンドプロンプトで　CDでのディレクトリの移動が出来ませんでした
次に
「’dir.txt’は、内部コマンドまたは外部コマンド、操作可能なプログラムまたはバッチファイルとして認識されていません。」
との、表示のためTXTファイルが作成されず試行を断念しました

ドライブだけでなくＰＣ本体にも問題があるのかも知れません
ともあれ助かりました、ありがとうございます　//