枠だけで、やりたい処理を書くだけにしています。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 |
Option Explicit 'ツールシート名 Public Const TOOL_SH_NAME As String = "Tool" '対象ディレクトリ取得先セルアドレス Public Const DIR_ADDRESS As String = "C3" '読み取り先のシート名 Public Const TARGET_SH_NAME As String = "Sheet1" ' Excelアプリケーションオブジェクト Private excelApp As Excel.Application Private shTool As Worksheet '--------------------------------------------------------------------------------------------------- '【処 理 名】 '【処理概要】 '【引 数】なし '【返 却 値】なし '--------------------------------------------------------------------------------------------------- Public Sub main() 'ツール > 参照設定 > Microsoft Scripting Runtime Dim oFso As New FileSystemObject 'ファイルシステムオブジェクト Dim oFile As File Dim path As String '初期処理 Call init path = shTool.Range(DIR_ADDRESS).Value For Each oFile In oFso.GetFolder(path).Files '読み取り専用で開く Call openBookByReadOnly(oFile) Next oFile Set oFile = Nothing Set oFso = Nothing '終期処理 Call term End Sub '--------------------------------------------------------------------------------------------------- '【処 理 名】 '【処理概要】ブックの読み取り '【引 数】ByVal oFile As File '【返 却 値】なし '--------------------------------------------------------------------------------------------------- Private Sub openBookByReadOnly(ByVal oFile As File) Dim wb As Workbook 'ワークブックオブジェクト Dim sh As Worksheet 'ワークシートオブジェクト Dim lastRow As Long '末尾行 Dim rowIndex As Long '行インデックス 'ワークブックを読み取り専用で開く Set wb = excelApp.Workbooks.Open(Filename:=oFile.path, UpdateLinks:=0, ReadOnly:=True, IgnoreReadOnlyRecommended:=True) 'ワークシートオブジェクト取得 Set sh = wb.Worksheets(TARGET_SH_NAME) '末尾行取得 lastRow = sh.Cells(Rows.count, 1).End(xlUp).Row '★★★★ ブックごとの処理を書く Debug.Print lastRow 'ワークブックを閉じる wb.Close SaveChanges:=False '後始末 Set wb = Nothing Set sh = Nothing End Sub '--------------------------------------------------------------------------------------------------- '【処 理 名】初期処理 '--------------------------------------------------------------------------------------------------- Private Sub init() Set excelApp = New Excel.Application Set shTool = ThisWorkbook.Worksheets(TOOL_SH_NAME) End Sub '--------------------------------------------------------------------------------------------------- '【処 理 名】終期処理 '--------------------------------------------------------------------------------------------------- Private Sub term() 'Excelアプリケーション終了 Call excelApp.Application.Quit Set excelApp = Nothing Set shTool = Nothing End Sub |