|
▼ぴょんきち さん:
【新規ファイルに】というところを読み飛ばしていました。
ついでに、フォルダ取得のサブプロシジャ、すこし手抜きのコードでしたので
ちょっと直してあります。
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
|
|