| |
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
これをシートモジュールに入れます。ただし、もともと拡張子の無いファイルには
対応しませんので、ご注意ください。
|
|
Kein
- 06/3/2(木) 20:10 -
