【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

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

コメントを残す コメントをキャンセル

コメントを残すコメントをキャンセル