2008年2月24日日曜日

VBA ~フォルダ内のファイル一覧の作成~

フォルダ内のファイル一覧の作成

A2から下に指定したフォルダ内にあるファイル名やフォルダ名を表示させます。
B2にはパス、C3には拡張子、D4には属性を記入し(パス以外は空欄でも大丈夫です)ボタンを押します。

---------------------------------------------------------------------------------------

Private Sub CommandButton1_Click()
  Dim path As String
  Dim FileType As String
  Dim File As String
  Dim FileAttribute As VbFileAttribute

  'フォルダのパス
  path = Trim(Cells(2, 2)) & "\"

  '属性の設定 セルのD2に対象の属性を書いておく。何もなければ標準ファイルになる
  FileAttribute = GetFileAttribute(Trim(Cells(2, 4)))

  'フォルダ名の表示以外は拡張子を設定
  If FileAttribute <> vbDirectory Then
     FileType = "*"
     '拡張子がない場合はファイルすべてが対象 セルはC2
     If Trim(Cells(2, 3)) <> "" Then
       FileType = FileType & "." & Trim(Cells(2, 3))
     End If
   End If

   '表示するファイル名を取得
   File = Dir(path & FileType, FileAttribute)

   Dim i As Integer
   i = 2

   'ファイル名一覧を作成
  Do While File <> ""
     '上の階層のフォルダは非表示
     If File <> ".." And File <> "." Then
      'フォルダの表示を選択した場合、ファイル名は表示しない
      If InStr(File, ".") <> 0 And FileAttribute = vbDirectory Then
      Else
         'A2から下に一覧を表示
         Cells(i, 1).Value = File
         i = i + 1
      End If
     End If
     File = Dir()
   Loop

   MsgBox ("作成完了!!")

End Sub

Private Function GetFileAttribute(FileAttribute As String) As VbFileAttribute
   '属性の設定
  Select Case FileAttribute
    Case "標準ファイル"
      GetFileAttribute = vbNormal
    Case "読み取り専用"
      GetFileAttribute = vbReadOnly
    Case "隠しファイル"
      GetFileAttribute = vbHidden
    Case "システムファイル"
      GetFileAttribute = vbSystem
    Case "ボリュームラベル"
      GetFileAttribute = vbVolume
    Case "フォルダ"
      GetFileAttribute = vbDirectory
    Case Else
      GetFileAttribute = vbNormal
  End Select
End Function

---------------------------------------------------------------------------------------

VBA

・フォルダを作る
・フォルダ内のファイル一覧の作成
・お気に入りにあるURLの一覧を作成(IEのみ)

バッチ

・連番でフォルダを作る

VBA ~フォルダを作る~

フォルダを作る


セルのA2からA30までに作りたいフォルダ名を書きます。
セルのA4にパスを書きます。
あと、エクセルのシートにボタンを挿入して、下のプログラムと対応ずければOK!!


---------------------------------------------------------------------------------------
Private Sub btnMakeDir_Click()
   Dim path As String
   Dim notUse As Variant

   'パス
   path = Trim(Cells(2, 4)) & "\"

  '連番
  'Dim Num As Integer
  'Num = 1


  'フォルダの作成を開始
  For i = 2 To 30 Step 1
    '何も書いていないセルはとばす
    If Cells(i, 1) <> "" Then
      '使用不可の文字は消去 \/:*?<>|と改行
      For Each notUse In Array("\", "/", ":", "*", "?", "<", ">", "|", vbLf)
        Cells(i, 1) = Replace(Trim(Cells(i, 1)), notUse, "")
      Next notUse

      '同じフォルダ名があるかどうかを判断
      If Dir(path & Cells(i, 1), vbDirectory) = "" Then
        'フォルダを作成
        MkDir path & Trim(Cells(i, 1))
        '連番をつける場合は上をコメントにして、下を使う
        'MkDir path & Format(Num, "0#") & "_" & Trim(Cells(i, 1))
        'Num = Num + 1
      End If
    End If
  Next i

  Range("A2:A30").Clear

  MsgBox ("フォルダ作成完了!!")

End Sub

---------------------------------------------------------------------------------------

バッチ ~連番でフォルダを作る~

連番でフォルダを作る


1~5までのフォルダを作りたい時はこのようにバッチファイルを作成します。

---------------------------------------------------------------------------------------
FOR /L %%V IN (1,1,5) DO MD パス名\%%V
---------------------------------------------------------------------------------------

「%%v」は変数なので、「%%a」とかでも大丈夫です。
INのかっこ内の意味は(開始の値、ステップ数、終了の値)です。