GetOpenFilename(単一ファイル)
Sub ファイル選択01()
Dim fName As Variant
fName = Application.GetOpenFilename(FileFilter:="Excelファイル,*.xls*", Title:="ファイルを選択してね")
Debug.Print fName
If fName = False Then
MsgBox "キャンセルされました"
Exit Sub
End If
'処理を記述
'例:選択されたファイルを開いて利用する場合
Application.ScreenUpdating = False
Dim tWb As Workbook
Set tWb = Workbooks.Open(fName)
Debug.Print tWb.Name
'......
tWb.Close SaveChanges:=False '保存する場合はTrue
Application.ScreenUpdating = True
Set tWb = Nothing
End Sub
GetOpenFilename(複数ファイル)
Sub ファイル選択02()
Dim fNameArr As Variant
fNameArr = Application.GetOpenFilename(FileFilter:="Excelファイル,*.xls*", Title:="ファイルを選択してね", MultiSelect:=True)
If Not IsArray(fNameArr) Then
MsgBox "キャンセルされました"
Exit Sub
End If
'処理を記述
'選択されたファイルを開いて利用する場合
Application.ScreenUpdating = False
Dim tWb As Workbook
Dim i As Long
For i = LBound(fNameArr) To UBound(fNameArr)
Set tWb = Workbooks.Open(fNameArr(i))
Debug.Print tWb.Name
'......
DoEvents
tWb.Close SaveChanges:=False '保存する場合はTrue
Next i
'
Application.ScreenUpdating = True
Set tWb = Nothing
End Sub
FileDialog(単一ファイル)
Sub ファイル選択03()
Dim fName As String
Dim tWb As Workbook
Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogFilePicker)
.Filters.Clear
.Filters.Add "Excelファイル", "*.xls*"
.InitialFileName = ThisWorkbook.Path
.AllowMultiSelect = False
.Title = "ファイルの選択"
If .Show = True Then
fName = .SelectedItems(1)
Debug.Print "選択フォルダは" & fName
Set tWb = Workbooks.Open(fName)
Debug.Print tWb.Name
'......
DoEvents
tWb.Close SaveChanges:=False '保存する場合はTrue
Else
MsgBox "キャンセルされました"
End If
End With
Application.ScreenUpdating = True
Set tWb = Nothing
End Sub
なんちゃって簡易版
Sub Sample()
Dim OpenFileName As Variant
OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?")
If OpenFileName <> False Then
Workbooks.Open OpenFileName
Else
MsgBox "キャンセルされました"
End If
End Sub
コメント