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
色々 戻り値:ユーザ定義関数
' === - Type定義 ===
Public Type FileSelectSingleResult
IsSuccess As Boolean
filePath As String
ErrorMessage As String
End Type
Public Type FileSelectMultiResult
IsSuccess As Boolean
FilePaths() As String
ErrorMessage As String
End Type
Public Type FileOpenResult
IsSuccess As Boolean
OpenedBook As Workbook
ErrorMessage As String
End Type
' === - (1):1ファイル選択(パスのみ) ===
Public Function zfSelectSingleExcelFile(ByVal dialogTitle As String) As FileSelectSingleResult
Dim fd As FileDialog
Dim result As FileSelectSingleResult
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Title = dialogTitle
.InitialFileName = ThisWorkbook.Path & "\"
.Filters.Clear
.Filters.Add "Excelファイル", "*.xls*"
.AllowMultiSelect = False
If .Show = -1 Then
result.IsSuccess = True
result.filePath = .SelectedItems(1)
Else
result.IsSuccess = False
result.filePath = ""
result.ErrorMessage = "キャンセルされました"
End If
End With
zfSelectSingleExcelFile = result
End Function
' === - (2):複数ファイル選択(配列で返す) ===
Public Function zfSelectMultiExcelFiles(ByVal dialogTitle As String) As FileSelectMultiResult
Dim fd As FileDialog
Dim result As FileSelectMultiResult
Dim i As Long
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Title = dialogTitle
.InitialFileName = ThisWorkbook.Path & "\"
.Filters.Clear
.Filters.Add "Excelファイル", "*.xls*"
.AllowMultiSelect = True
If .Show = -1 Then
ReDim result.FilePaths(1 To .SelectedItems.Count)
For i = 1 To .SelectedItems.Count
result.FilePaths(i) = .SelectedItems(i)
Next i
result.IsSuccess = True
Else
result.IsSuccess = False
result.ErrorMessage = "キャンセルされました"
End If
End With
zfSelectMultiExcelFiles = result
End Function
' === - (3):1ファイル選択し、ブックを開く ===
Public Function zfTryOpenExcelFile(ByVal dialogTitle As String) As FileOpenResult
Dim fd As FileDialog
Dim filePath As String
Dim result As FileOpenResult
Dim wb As Workbook
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Title = dialogTitle
.InitialFileName = ThisWorkbook.Path & "\"
.Filters.Clear
.Filters.Add "Excelファイル", "*.xls*"
.AllowMultiSelect = False
If .Show = -1 Then
filePath = .SelectedItems(1)
On Error Resume Next
Set wb = Workbooks.Open(filePath)
On Error GoTo 0
If wb Is Nothing Then
result.IsSuccess = False
result.ErrorMessage = "ファイルのオープンに失敗しました"
Else
result.IsSuccess = True
Set result.OpenedBook = wb
End If
Else
result.IsSuccess = False
result.ErrorMessage = "キャンセルされました"
End If
End With
zfTryOpenExcelFile = result
End Function
’------------------実行プロシージャ------------------------------
Sub Test_①()
Dim res As FileSelectSingleResult
res = zfSelectSingleExcelFile("1つExcelファイルを選んでください")
If res.IsSuccess Then
Debug.Print "選択されたファイル:" & res.filePath
Else
Debug.Print "選択なし:" & res.ErrorMessage
End If
End Sub
Sub Test_②()
Dim res As FileSelectMultiResult
Dim i As Long
res = zfSelectMultiExcelFiles("複数Excelファイルを選んでください")
If res.IsSuccess Then
For i = LBound(res.FilePaths) To UBound(res.FilePaths)
Debug.Print res.FilePaths(i)
Next i
Else
Debug.Print "選択なし:" & res.ErrorMessage
End If
End Sub
Sub Test_③()
Dim res As FileOpenResult
res = zfTryOpenExcelFile("Excelファイルを開いてください")
If res.IsSuccess Then
Debug.Print "開いたファイル名:" & res.OpenedBook.Name
Debug.Print "開いたファイルパス:" & res.OpenedBook.FullName
Else
Debug.Print "選択なし:" & res.ErrorMessage
End If
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
コメント