| |
時間がないので、手持ちのをすこし編集しました。
参考になれば幸いです。
Sub sample()
Dim ファイル As String
Dim 一覧 As String
Dim Result As Long
Dim myObj As Object
Dim myDir As String
'Application.ScreenUpdating = False
Set myObj = CreateObject("Shell.Application"). _
BrowseForFolder(0, "フォルダを選択してください", 0)
If myObj Is Nothing Then Exit Sub
myDir = myObj.Items.Item.Path & "\"
'##################################
' 同フォルダ内のExcelファイル検出
'##################################
ファイル = Dir(myDir & "*.xls")
Do While ファイル <> ""
If ファイル = ThisWorkbook.Name Then ファイル = ""
一覧 = 一覧 & Chr(13) & ファイル
ファイル = Dir()
Loop
Result = MsgBox("以下のファイルが見つかりました。実行しますか？" & Chr(13) & 一覧, 4, "ファイル確認")
If Result = 7 Then
Exit Sub
End If
'########################
' データのコピー
'########################
ファイル = Dir(myDir & "*.xls")
Do While ファイル <> ""
If ファイル <> ThisWorkbook.Name Then
'ファイルを開く
Workbooks.Open Filename:=myDir & ファイル
MsgBox ファイル & "を開いています。ここでコピー処理します。"
'ファイルを閉じる
ActiveWorkbook.Close False
End If
ファイル = Dir()
Loop
'Application.ScreenUpdating = True
End Sub
|
|
INA
- 03/10/22(水) 16:50 -
