ちょっと生きづらさを抱えた人へ、気持ちを楽にするためのお手紙です。

【VBA】他ブックを開いて読み込むときのテンプレ

枠だけで、やりたい処理を書くだけにしています。

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

コメントを残す

メールアドレスが公開されることはありません。

CAPTCHA