【VBA】ファイル選択ダイアログ(単一・複数ファイル)

0

    <機能>

    (1)単一ファイル選択ダイアログを表示

    (2)複数ファイル選択ダイアログを表示

     

    <動作検証>
    Microsoft Office 2016

     

    <実行イメージ>

    設定は

    ・ダイアログタイトル

    ・単一ファイル/複数ファイル選択

    ・ファイルフィルター(txtまたはcsv)

    ・初期表示フォルダ

    (エクセルブックと同じフォルダを指定)

    ファイル選択ダイアログイメージ

    複数ファイル選択結果を表示したところ

    複数ファイル選択結果

     

    <使い方>
    適当なところにソースを貼り付けてください

    ファイルを選択する() を実行すると処理を開始します

     

    '/********************************************************
    '/* ファイル選択ダイアログ(単一/複数ファイル選択)を表示する
    '/* 引数:
    '/*  strDefault 初期表示フォルダ
    '/*  isMulti    trueのとき複数ファイル選択可能
    '/* 戻り値:
    '/*  選択されたときtrue、キャンセルされたときfalse
    '/*  strSelect  選択されたファイルフルパス(参照)
    '/********************************************************

    Function SelectFile(ByVal strDefault As String, _
                        ByVal isMulti As Boolean, _
                        ByRef strSelect() As String) As Boolean
        Dim sItem As Variant
        SelectFile = False
        ReDim strSelect(0)
        strSelect(0) = ""
        
        '//ファイル選択ダイアログを表示
        '//DialogTypeは以下の通りです(
    詳細はMSDN参照)
        '//msoFileDialogFilePicker ファイルの参照
        '//msoFileDialogFolderPicker フォルダの参照
        '//msoFileDialogOpen ファイルを開く
        '//msoFileDialogSaveAs 名前を付けて保存

        With Application.FileDialog(msoFileDialogFilePicker)
            '複数選択不可(単一/複数ファイル選択)
            .AllowMultiSelect = isMulti
            '初期表示フォルダ
            .InitialFileName = strDefault & "¥"
            'ファイルフィルター(txt/csvフィルターを一番上に表示)
            .Filters.Add "テキストファイル", "*.txt;*.csv", 1
            'エクセルファイル選択のとき
            '.Filters.Add "MSエクセルファイル", "*.xls*", 1
            'タイトルを指定
            .Title = "ファイル選択ダイアログサンプル"
            
            'ファイルが選択された
            If .Show = True Then
                For Each sItem In .SelectedItems
                    If strSelect(0) <> "" Then
                        '配列を拡張
                        ReDim Preserve strSelect(UBound(strSelect) + 1)
                    End If
                    strSelect(UBound(strSelect)) = sItem
                    SelectFile = True
                Next sItem
            Else
                .Execute
            End If
        End With
    End Function


    '/********************************************************
    '/* ファイル選択ダイアログ呼び出しサンプル
    '/********************************************************

    Public Sub ファイルを選択する()
        Dim strSelect() As String
        Dim wksel As Variant, wkmsg As String
        
        '//(1)単一ファイルを選択する
        If Not SelectFile(ThisWorkbook.Path, False, strSelect()) Then
            MsgBox "ファイル選択がキャンセルされました", vbCritical
            GoTo multiselect
        End If
        
        '//選択された単一ファイルを表示
        MsgBox "選択ファイル:" & vbCrLf & strSelect(0), vbInformation
        
    multiselect:
        
        '//(2)複数ファイルを選択する
        If Not SelectFile(ThisWorkbook.Path, True, strSelect()) Then
            MsgBox "ファイル選択がキャンセルされました", vbCritical
            Exit Sub
        End If
        
        '//選択された複数ファイルを表示
        wkmsg = ""
        For Each wksel In strSelect
            wkmsg = wkmsg & vbCrLf & wksel
        Next wksel
        MsgBox "選択ファイル:" & wkmsg, vbInformation
    End Sub
     

    よろしければポチッと押してください

    プログラマー ブログランキングへ

     

     



    calendar

    S M T W T F S
       1234
    567891011
    12131415161718
    19202122232425
    2627282930  
    << November 2017 >>

    profile

    others

    mobile

    qrcode