| 
    
     |  | ▼ぴょんきち さん: 
 【新規ファイルに】というところを読み飛ばしていました。
 ついでに、フォルダ取得のサブプロシジャ、すこし手抜きのコードでしたので
 ちょっと直してあります。
 
 Option Explicit
 
 Sub Sample1()
 Dim myPath As String
 Dim myFile As String
 Dim c As Range
 
 myPath = Get_Folder
 If myPath = "" Then Exit Sub
 
 Application.ScreenUpdating = False
 
 Workbooks.Add
 Cells.ClearContents
 Range("A1").Value = "ファイル名"
 Set c = Range("A2") '編集開始位置
 
 myFile = Dir(myPath & "\")
 Do While myFile <> ""
 c.Value = myFile
 Set c = c.Offset(1)
 myFile = Dir()
 Loop
 
 Columns("A").AutoFit
 
 Set c = Nothing
 Application.ScreenUpdating = True
 
 End Sub
 
 Private Function Get_Folder() As String
 Dim ffff As Object
 Dim WSH As Object
 
 Set WSH = CreateObject("Shell.Application")
 Set ffff = WSH.BrowseForFolder(&H0, "フォルダを選択してください", &H1 + &H10)
 If ffff Is Nothing Then
 Get_Folder = ""
 Else
 Get_Folder = ffff.Items.Item.Path
 End If
 
 Set ffff = Nothing
 Set WSH = Nothing
 
 End Function
 
 
 |  |