Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


8047 / 13644 ツリー ←次へ | 前へ→

【35386】ファイルの一覧を作りたい 奄美の初心者 06/3/2(木) 18:54 質問[未読]
【35387】Re:ファイルの一覧を作りたい 奄美の初心者 06/3/2(木) 18:56 発言[未読]
【35392】Re:ファイルの一覧を作りたい Kein 06/3/2(木) 20:15 回答[未読]
【35391】Re:ファイルの一覧を作りたい Kein 06/3/2(木) 20:10 回答[未読]
【35393】Re:ファイルの一覧を作りたい 奄美の初心者 06/3/2(木) 20:24 お礼[未読]
【35394】Re:ファイルの一覧を作りたい Kein 06/3/2(木) 20:40 発言[未読]
【35399】Re:ファイルの一覧を作りたい 奄美の初心者 06/3/2(木) 22:20 お礼[未読]

【35386】ファイルの一覧を作りたい
質問  奄美の初心者  - 06/3/2(木) 18:54 -

引用なし
パスワード
   はじめまして。

題名のとおりファイルの一覧を作りたいです。
具体的には、C:\a というフォルダの中に、複数のフォルダがあります。
その複数のフォルダの中にたくさんのファイルがあります。

このファイルの一覧を作りたいと思っています。
そこで、以下のとおりコードを作ってみたのですが動きません。
FileSearchをヘルプで見たのですがよくわかりません。

Sub test()
With Application.FileSearch
  .LookIn = "C:\a"
  .SearchSubFolders = True
  
  If .Execute() > 0 Then
    For i = 1 To .FoundFiles.Count
      Cells(i, 1).Value = .FoundFiles(i)
    Next i
  End If
End With
End Sub

また、一覧を作った後、ファイル名の変更も考えています。
ファイル名の変更するコードも教えていただけるとありがたいです。

よろしくお願いします。

【35387】Re:ファイルの一覧を作りたい
発言  奄美の初心者  - 06/3/2(木) 18:56 -

引用なし
パスワード
   追加です。
一覧を作りたいファイルはエクセルファイルではありません。
拡張子のないファイルです。

【35391】Re:ファイルの一覧を作りたい
回答  Kein  - 06/3/2(木) 20:10 -

引用なし
パスワード
   FAQですね。FileSearchはバグりやすいそうなので、FSOを使うことをお勧めします。

Sub Test_GetFile()
  Dim FSO As Object, SFols As Object
  Dim SFl As Object, F As Object
  Dim i As Long
  Const MyFol As String = "C:\a"

  Columns(1).ClearContents
  Set FSO = CreateObject("Scripting.FileSystemObject")
  Set SFol = FSO.GetFolder(MyFol).SubFolders
  For Each SFl In SFol
   If SFl.Files.Count > 0 Then
     For Each F In SFl.Files
      i = i + 1
      Cells(i, 1).Value = SFl.Name & "\" & F.Name
     Next
   End If
  Next
  Set SFol = Nothing: Set FSO = Nothing
End Sub
 
>一覧を作った後、ファイル名の変更も
入力されたセル範囲(A列)から、目的のファイル名のセルを選んでダブルクリック
することで、そのファイル名を変更できるようにしたら良いと思います。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
  Dim x As Long
  Dim Ph As String, Bs As String, NewN As String
  Const MyF As String = "C:\a\" '←末尾に\を入れること
 
  On Error Resume Next
  If Intersect(Target, Range("A:A").SpecialCells(2, 2)) _
  Is Nothing Then Exit Sub
  If Err.Number <> 0 Then Exit Sub: Cancel = True
  With Target
   If Mid$(StrReverse(.Value), 4, 1) <> "." Then Exit Sub
   x = InStrRev(.Value, "\")
   If x = 0 Then Exit Sub
   Ph = Left$(.Value, x)
   Bs = Right$(.Value, 4)
  End With
  NewN = InputBox("変更するファイル名を" & _
  " 拡張子なしで入力して下さい")
  If NewN = "" Then Exit Sub
  Name MyF & Target.Value As MyF & Ph & NewN & Bs
  Target.Value = Ph & NewN & Bs
End Sub
    
これをシートモジュールに入れます。ただし、もともと拡張子の無いファイルには
対応しませんので、ご注意ください。

【35392】Re:ファイルの一覧を作りたい
回答  Kein  - 06/3/2(木) 20:15 -

引用なし
パスワード
   あー・・送信してから気が付いた・・。逆に拡張子なしのファイルに"限定"するなら

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
  Dim x As Long
  Dim Ph As String, NewN As String
  Const MyF As String = "C:\a\" '←末尾に\を入れること
 
  On Error Resume Next
  If Intersect(Target, Range("A:A").SpecialCells(2, 2)) _
  Is Nothing Then Exit Sub
  If Err.Number <> 0 Then Exit Sub: Cancel = True
  With Target
   If Mid$(StrReverse(.Value), 4, 1) = "." Then Exit Sub
   x = InStrRev(.Value, "\")
   If x = 0 Then Exit Sub
   Ph = Left$(.Value, x)
  End With
  NewN = InputBox("変更するファイル名を" & _
  " 拡張子なしで入力して下さい")
  If NewN = "" Then Exit Sub
  Name MyF & Target.Value As MyF & Ph & NewN
  Target.Value = Ph & NewN
End Sub

と、変更して下さい。

【35393】Re:ファイルの一覧を作りたい
お礼  奄美の初心者  - 06/3/2(木) 20:24 -

引用なし
パスワード
   ▼Kein さん:
>FAQですね。FileSearchはバグりやすいそうなので、FSOを使うことをお勧めします。
Keinさんありがとうございます。
FAQにあったのですが、参照設定をやってもうまく動いてくれなかったので、FileSearchで自分でやってみたのですが、FileSearchも理解してないので新たに質問しました。

教えていただいたものを貼り付けて動かしてみます。
内容を勉強して、結果は後で報告させていただきます。

ありがとうございました。

【35394】Re:ファイルの一覧を作りたい
発言  Kein  - 06/3/2(木) 20:40 -

引用なし
パスワード
   すいません。訂正です
> SFols As Object


SFol As Object

というように、変数宣言のところを直して下さい。
なおFAQというのは "よく出てくる質問" ぐらいの意味です。

【35399】Re:ファイルの一覧を作りたい
お礼  奄美の初心者  - 06/3/2(木) 22:20 -

引用なし
パスワード
   Keinさん

Set FSO = CreateObject("Scripting.FileSystemObject")
の内容はぜんぜん分からないままですが、結果として望んでいたものができました。
ファイル名の変更はNameステートメントをヘルプで調べて分かりました。

ありがとうございました。

8047 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free