Excelスキルアップコレクション
           〜 Something U Want 〜


Google  

WWW を検索
Excelスキルアップコレクション内 を検索
 @     Top  >     Excel VBA スキルアップコレクション Topics  >     (22) Excelファイルを読み取り専用で開き保存せずに閉じる

 
(22) Excelファイルを読み取り専用で開き保存せずに閉じる

 特定のフォルダにテスト結果のExcelファイルが大量に格納されており、それらを一つずつ開いてテスト結果の集計を取る作業が発生したとします。集計作業用のマクロを作成する際に、そのマクロに不具合があり、集計対象の大量のExcelファイルを上書き更新してしまうことがあってはなりません。集計結果が誤って表示されることよりも、集計対象の元ファイルに手を入れてしまうことだけは避けるようにしましょう。

 複数のExcelファイルの自動集計マクロを作成する場合は、「集計対象ファイルを読み取り専用で開き、保存無しで閉じる。」を鉄則として守りたいものです。

 特定フォルダ配下にあるExcelファイルの探し方は、「22. フォルダに存在するファイルの一覧を作成する」で紹介しました。この方法を利用して、特定のフォルダ配下のExcelファイルを順番に読み取り専用で開き、集計処理実施後、保存せずに閉じるループ処理の雛形を紹介します。

 下記サンプルコードは、特定のフォルダ配下のExcelファイルを順番に開いて閉じるサンプルです。

 1行目:  Public Sub Sample_RefExcelFiles_01()
 2行目:  
 3行目:      ' フォルダ参照ダイアログを利用して、フォルダを特定する。
 4行目:      Dim folderName As Variant
 5行目:      Set folderName = CreateObject("Shell.Application") _
 6行目:                          .BrowseForFolder( _
 7行目:                                  &O0 _
 8行目:                                  , "フォルダ選択" _
 9行目:                                  , &H1 + &H10 _
10行目:                                  , "デスクトップ")
11行目:      
12行目:      ' フォルダが選択されたか否か判別する。
13行目:      If folderName Is Nothing Then
14行目:          MsgBox "中止します"
15行目:          Exit Sub
16行目:      End If
17行目:  
18行目:      ' 単純なループカウンタ
19行目:      Dim lp1 As Long, lp2 As Long
20行目:  
21行目:      ' FileSystemObjectを作成する。
22行目:      Dim Obj As Object
23行目:      Set Obj = CreateObject("Scripting.FilesystemObject")
24行目:  
25行目:      ' 選択されたフォルダ配下に存在するファイル名を取出す為の変数
26行目:      Dim fileName As String
27行目:      Dim fileNames() As String
28行目:      ReDim fileNames(0) As String
29行目:  
30行目:      ' 選択されたフォルダ配下に存在するファイル名を取出す
31行目:      fileName = Dir(folderName.Self.path & "\*.xls")
32行目:      Do While fileName <> vbNullString
33行目:          ' ファイル名を配列に取込む。
34行目:          ReDim Preserve fileNames(UBound(fileNames) + 1) As String
35行目:          fileNames(UBound(fileNames)) = _
36行目:              folderName.Self.path & "\" & fileName
37行目:          fileName = Dir()
38行目:      Loop
39行目:  
40行目:      ' 全てのExcelファイルを順次開いて閉じる。
41行目:      For lp1 = 1 To UBound(fileNames)
42行目:      
43行目:          ' Excelファイルを読み取り専用で開く。
44行目:          Workbooks.Open _
45行目:              fileName:=fileNames(lp1) _
46行目:              , ReadOnly:=True
47行目:  
48行目:          ' 開いたファイルのブック名を取得する。
49行目:          Dim bookName As String
50行目:          bookName = Obj.GetFileName(fileNames(lp1))
51行目:          
52行目:          ' 開いたファイルの全シートを全て参照する。
53行目:          For lp2 = 1 To Workbooks(bookName).Sheets.Count
54行目:              ' ***************
55行目:              ' 集計処理を行う
56行目:              ' ***************
57行目:          Next
58行目:          
59行目:          
60行目:          ' 開いていたExcelファイルを保存せずに閉じる。
61行目:          Workbooks(bookName).Close SaveChanges:=False
62行目:  
63行目:      Next
64行目:      
65行目:      ' メモリを解放する。
66行目:      Erase fileNames
67行目:      
68行目:      ' オブジェクトを破棄する。
69行目:      Set Obj = Nothing
70行目:      Set folderName = Nothing
71行目:  
72行目:  End Sub
 簡単にプログラムについて説明します。
 5行目〜10行目で、『フォルダ参照』ダイアログを利用しています。ここでExcelファイルが格納されているフォルダを特定しますが、ダイアログにて[キャンセル]ボタンをクリックされた場合は、処理を中断したいので、[キャンセル]ボタンのクリック有無を13行目〜16行目でチェックしています。
  31行目〜38行目では、Dir()関数を利用して、特定のフォルダ配下の"*.xls"で終わるファイル名の一覧を配列に取り出しています。
  41行目は、取得したファイル名の一覧を一つずつ参照し、Excelファイルの開閉処理を繰り返す為のループです。
  44行目〜46行目はExcelファイルを開くステートメントです。オプションReadOnlyをTrueにすることで、読み取り専用でファイルを開くことができます。

        Workbooks.Open _
            fileName:=ファイルのフルパス _        
            , ReadOnly:=True
  61行目はExcelファイルを閉じるステートメントです。オプションSaveChangesをFalseにすることで、ファイルを保存せずに閉じることができます。万が一、何か編集作業を行ったとしても、変更内容を保存するか否かの確認メッセージが表示されることすらありません。

        Workbooks(ブック名).Close SaveChanges:=False         
ページの先頭へ