複数フォルダー名（ファイル名）を書き出す
現在、以下のコードで
フォルダー名又はファイル名（拡張子ナシ）をA2セルに書き込むようにしています。
これを複数個読み込むように改造できないでしょうか ？
読み込む回数を指定してA2から下へ順番に回数分だけループさせて書き込んでいけば
処理自体は完結します。
それでは、ループ回数が増えればそれだけ手数が必要なので
現在は、ファイラーでターゲットを複数選択状態で
右クリック拡張で機能追加した「ファイル名（フォルダー名）をコピー」を選択して
A2に一括してコピペしています。
（ｃｔｒｌ＋左クリックで複数選択可能）
ファイラーを利用する方法でも良いのですが、
EXCELだけで複数個読み込むように改造することはできますか ？
-----------------------------------------
大幅な改造と言うか、ほぼ新しく作成になるようなら
WEBの参考記事だけの紹介でも十分です。
------------------------------------------
Sub FolderName__FileName__Picker()
Dim dlg As Object
Dim blAns As Boolean
Dim p As Single
Dim FolName As Variant
Dim rc As VbMsgBoxResult
Dim Ws1 As Worksheet, Ws2 As Worksheet
Set Ws1 = Sheets("DATA")
Set Ws2 = Sheets("Number")
'DATA,Numberシートの初期化（全体=数式・文字・書式・コメント全てをクリア）
Ws1.Range("A1:XX100").Clear
Ws2.Range("A1:XX100").Clear
'フォルダー名又はファイル名、いずれで処理するか ？
rc = MsgBox("Folder名で処理しますか ?", vbYesNo + vbQuestion, "Folder処理 or File処理")
If rc = vbYes Then
'Get FolderName（フォルダー名で処理）
Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
blAns = dlg.Show
If blAns Then
FolName = dlg.SelectedItems(1)
p = InStrRev(FolName, "\")
Range("A1") = "フォルダー名(拡張子を含まない)"
Ws1.Range("A1").HorizontalAlignment = xlCenter
Ws1.Range("A1").Font.Bold = True
Ws1.Range("A2") = Mid(FolName, p + 1, Len(FolName) - p)
Else
MsgBox "フォルダ選択がキャンセルされました。"
End If
Else
'GetFileName without Filename Extension（ファイル名で処理、拡張子は除く）
Dim GetFileName As String
Dim FNLen As Single
GetFileName = Application.GetOpenFilename()
GetFileName = Dir(GetFileName)
FNLen = Len(GetFileName)
GetFileName = Left(GetFileName, FNLen - 4)
Ws1.Range("A1") = "ファイル名"
Ws1.Range("A1").HorizontalAlignment = xlCenter
Ws1.Range("A1").Font.Bold = True
Ws1.Range("A2") = GetFileName 'パスを含まないファイル名
End If
'続けてNumberling処理するか選択
rc = MsgBox("Numberling ?", vbYesNo + vbQuestion, "連続処理")
If rc = vbYes Then
Call Nubering3
Else
MsgBox "Numberling処理がキャンセルされました。"
End If
End Sub
![その他([技術者向] コンピューター) イメージ](https://gazo.okwave.jp/okwave/spn/images/related_qa/c205_4_thumbnail_img_sm.png)
![その他([技術者向] コンピューター) イメージ](https://gazo.okwave.jp/okwave/spn/images/related_qa/c205_1_thumbnail_img_sm.png)
