Menuへ
ExcelでTOTO解析ソフトを作ってみよう

Step 2　試合結果のエクセルファイル一覧を作成


試合結果のエクセルファイルがあるフォルダを指定し、ファイル名の一覧を作成します。
シート画面
「引き分け数の調査」ボタンをクリックすると、フォルダ選択ダイアログが開きます。
指定されたフォルダ内から、拡張子が「xls」のファイルのみ取り出しB10から書き出します。
フォルダを選択してください

TOTO試合結果のファイル一覧を作成します。
エクセルファイルの一覧

シートコード

Option Explicit

'フォルダ内のファイルリストを作成
Private Function ExGetFileList(strPath As String) As Long
    Dim i As Long
    Dim tSfo As Object
    Dim tGf As Object
    Dim tFi As Object
    Dim tSub As Object
    
    'クリア
    i = 10
    Range("B10:B500").Clear

    Set tSfo = CreateObject("Scripting.FileSystemObject")
    Set tGf = tSfo.GetFolder(strPath)
    For Each tFi In tGf.Files
        '拡張子のチェック
        If tSfo.GetExtensionName(tFi.Path) = "xls" Then
            'ファイル名
            Cells(i, 2) = tFi.Name
            i = i + 1
        End If
    Next
    ExGetFileList = i - 10
End Function

Private Function SelectFolder_FileDialog(iniDir As String) As String
    Dim s1 As String
    
    'フォルダ選択ダイアログ
    With Application.FileDialog(msoFileDialogFolderPicker)
        'タイトル
        .Title = "フォルダを選択してください"
        '初期フォルダ
        .InitialFileName = iniDir
        If .Show = -1 Then
            '選択された
            s1 = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
            If Right$(s1, 1) <> "\" Then s1 = s1 + "\"
            SelectFolder_FileDialog = s1
        Else
            SelectFolder_FileDialog = ""
        End If
    End With
End Function

Private Sub CommandButton1_Click()
    Dim sdir As String
    Dim lcount As Long
    
    '試合結果のエクセルファイルがあるフォルダ
    sdir = SelectFolder_FileDialog(ActiveWorkbook.Path)
    If sdir <> "" Then
        lcount = ExGetFileList(sdir)
    End If

End Sub


Topへ
■このサイトの内容を利用して発生した、いかなる問題にも一切の責任は負いませんのでご了承下さい。■
当ホームページに掲載されているあらゆる内容の無許可転載・転用を禁止します。

Copyright (c) 2006-2007 Excel-Excel ! All rights reserved.