サンプル

ファイル保管(エクセルVBA)

文書の保管には、PDFファイルが便利ですよね。

うちの法律事務所では、届いた書類は全部スキャナーでPDFファイルにしています。届いたFAXもPDFファイルで読めるようにしています。でも、そのPDFファイルを事件ごとのフォルダに振り分けて保管するのが大変です。

マクロを使えば、エクセルでファイルの整理を行うこともできますよ。

そんなことができるんですか?
ぜひ、教えて下さい。

ダウンロード

まずは、サンプル・ファイルをダウンロードしてください。


ブック(ファイルに保存されたエクセルのデータ全体)を開くと「ファイルがありません」というメッセージがでますが、問題ありません。

このマクロには、デジタル証明を添付しています。必要な設定を行って、マクロを使える状態にしてください。設定方法が分からない方は、こちらのサイトに詳しい説明があります。

使用方法

  • ファイルを開くと、オプションで指定したフォルダ内にあるファイル名が読み込まれます。
  • 各項目のセルをダブルクリックすることにより、保管先のフォルダとファイル名が自動入力されます。
  • 保管日時のセルをダブルクリックすると、ファイル名の変更とファイルの移動が行われます。
  • フォルダ名やファイル名には、ハイパーリンクが設定されていますので、クリックすることでフォルダやファイルの内容を確認できます。

細部については、ブックの「マニュアル」シートを参照してください。

なお、このサンプルは、ファイル保管をマクロで行う場合の参考にしていただくためのものです。
使用にあたっては、それぞれの法律事務所に応じた修正を行ったうえでお使いください。

このサンプルをそのまま使うこともできますよね。

そうなんですが、それではマクロを使う意味がありません。できあいのプログラムを使うのであれば、もっと良いソフトがいくらでもあると思います。
マクロの良いところは、自分の使いやすいプログラムを自分自身で手軽に作れることです。ぜひ、このサンプルを参考に自分の法律事務所にピッタリのファイル保管プログラムを作っていただきたいと思います。

分かりました。
でも、難しそうですね。

次のページから、このプログラムの構造・機能を説明してゆきます。
プログラムのどの部分がどんな働きをしているのかが分かれば、修正するのは案外簡単だと思います。

すいませんが、忙しいので、手短に説明してくださいね。

ブックとワークシートの構成

まずは、「ファイル保管」のワークシートについて、説明します。

説明して欲しいのは、マクロのことなのですが...

ワークシートをどのように作っているのかが分かっていないと、マクロがどのように働いているのかが分かりませんので、少しお付き合いください。

ブックの構成

ブックには、次の3つのシートが作られています。

  • 「保管」シート
  • 「事件」シート
  • 「オプション」シート
  • 「マニュアル」シート

「保管」シートの構成

「保管」シートには、ファイルの保管に関する情報をテーブル機能を使って入力・表示できるようにしています。

テーブルの作成方法については、こちらのサイトを参考にしてください。

「保管」シート

「事件」シートの構成

「事件」シートには、各事件の依頼人氏名などとデータフォルダが入力できるようにしています。

「事件」シート

「オプション」シートの構成

「オプション」シートには、「読み込みフォルダ」および「保管フォルダ初期値」が入力されています。

「オプション」シート

「マニュアル」シートの構成

「マニュアル」シートには、「ファイル保管」の使用法と変更履歴を記載しています。

「マニュアル」シート


以上でブックとワークシートに関する説明を終わります。

テーブルを使うということが重要なんですね。

そうなんです。VBAの参考書では、後ろの方にならないと出てこないですが、データベースとしてエクセルを使うことが多い法律事務所の業務においては、非常に重要なテクニックです。

マクロの構造

それでは、「ファイル管理」のマクロの全体構造を説明しましょう。

いよいよマクロに関する説明ですね。

VBEへの入力位置

「開発」-「Visual Basic」をクリックして、VBEを起動してください。

エクセルの初期設定では、「開発」タブが表示されていないので、VBAのエディターを開くことができません。
まだ、設定が終わっていない方は、こちらのサイトを参考に設定を行ってください。

左上の「プロジェクト・エクスプローラー」部で各モジュールをクリックすると、そこに記載されているコードが真ん中の「コード・エディター」部に表示されます。

見ていただくとお分かりのとおり、ほとんどのコードがシートモジュールに記載されています。標準モジュールには、ごくわずかしかコードが記載されていません。

私の持っている教科書では、マクロは「標準モジュール」に書くのが基本だと書いてあります。

そうですね。
でも、実は、シートに関係するコードは、そのシートに書いた方が、プログラムを構造化できますし、コードの記述も簡単になるんです。

プロジェクトの構成

「ファイル管理」プロジェクトの構成は、次の図のようになっています。

プロジェクトの構成

全てのマクロは、イベントプロシージャで起動しています。

これも教科書とは全然違いますよ。
マクロを実行するためには、シート上にボタンを配置したり、ショートカットキーに登録したりするのが基本的なやり方だとされています。

そうですね。イベントプロシージャは、教科書の後ろの方に応用的なテクニックとして記載されていることが多いようですね。
でも、最もエクセルらしい直感的な操作ができますし、特別なボタンを作成したりする手間も省けるので、積極的に使うべきだと考えています。

「ThisWorkbook」モジュールの機能

ThisWorkbook」モジュールには、ブックを開いた時に起動する「Workbook_Open」プロ―シージャが組み込まれており、ファイル名の読み込みを行います。

「Sheet11」モジュールの機能

Sheet11」モジュールには、まず、「保管」シートをダブルクリックした時に起動する「Worksheet_BeforeDoubleClick」プロシージャ、シートに変更が加えられた時に起動する「Worksheet_Change」プロシージャ、およびシートの選択位置が変わった時に起動する「Worksheet_SelectionChange」プロシージャが組み込まれており、それぞれのイベントに応じたマクロを呼び出しています。

次の3つのプロシージャがこのシステムの中核となるマクロになります。
ReadFileNames」プロシージャは、オプションシートで設定されたフォルダ内にあるファイルのファイル名をシートに読み込みます。
MoveFile」プロシージャは、そのファイルを指定されたフォルダに指定されたファイル名で移動します。
RstrFile」プロシージャは、移動したファイルを元のフォルダに、元の名前で復旧します。

このほかに、テーブルの並び替えを行う「SortTable」プロシージャ、テーブルの書式を設定する「FormatTable」プロシージャ、保管フォルダの入力を行う「InputStoredFolder」プロシージャおよび保管ファイル名の入力を行う「InputStoredFile」プロシージャがあり、必要に応じて、他のプロシージャから呼び出されるようになっています。

「Sheet21」モジュールの機能

「Sheet21」モジュールには、「事件」シートが開かれた時に起動する「Workxheet_Activate」プロシージャとシートをダブルクリックした時に起動する「Worksheet_BeforeDoubleClick」プロシージャが組み込まれおり、それぞれのイベントに応じたマクロを呼び出しています。

「Module11」の機能

標準モジュールである「Module11」モジュールには、イベントの抑止およびその解除などを行うプロシージャが組み込まれています。

DsblEvents 」プロシージャは、マクロ実行中のイベントの発生を抑止して、イベントが連鎖するのを防止します。併せて、画面の描画などを停止して、マクロの実行速度の向上を図っています。
EnblEvents」プロシージャは、「DsblEvents」が行った設定を解除するプロシージャです。

マクロの内容にもよるのですが、基本的には、マクロの開始時にイベントの発生を抑止し、マクロの終了時に再開するようにしています。

以上で、マクロの構造に関する説明を終わります。

重要なのは「読み込み」「移動」「復旧」の3つのプロシージャなのですね。

そのとおりです。その3つのプロシージャには、ファイルの操作に関するマクロが含まれています。それ以外のプロシージャには、基本的なマクロしか使われていません。ただし、かなり複雑に組み合わされていますので、自分で最初から作ってみた方が理解しやすいかもしれません。

コードの説明

「ThisWorkbook」モジュール

「Workbook_Open」プロシージャ

Option Explicit

Private Sub Workbook_Open()
Call DsblEvents

'ファイル名を読み込む
Call Sheet11.ReadFileNames
            
Call EnblEvents

End Sub

ファイルを開いた際に、保管処理を行うファイルのファイル名の読み込みを行います。

「Workbook_BeforeSave」プロシージャ

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Call DsblEvents

'保管シートを並び替える
Call Sheet11.SortTable

'保管シートの書式を設定する
Call Sheet11.FormatTable

'事件シートを並び替える
Call Sheet21.SortTable

'事件シートの書式を設定する
Call Sheet21.FormatTable


Call EnblEvents
End Sub

ファイルを保存する前に各シートの並び替えおよび書式設定を行います。

「Sheet11(保管)」モジュール

Option Explicit
Dim r As Long, s As Long                 '保管を行うテーブル行・列番号
Dim brnMoveFile As Boolean               '保管完了フラグ値

モジュールレベルの変数を宣言しています。

Worksheet_BeforeDoubleClick

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim t As Long, v As Long

'ターゲットのテーブル行・列番号を計算する
r = Target.Row - Range("保管").Row + 1          'テーブル行番号
s = Target.Column - Range("保管").Column + 1    'テーブル列番号

'テーブル行・列番号が入力範囲外の場合は終了する
If r < 1 Or Range("保管").Rows.Count + 1 < r Then Exit Sub
If s < 1 Or Range("保管").Columns.Count < s Then Exit Sub

Call DsblEvents

Select Case Range("保管")(0, s).Value
    Case "番号", "読込フォルダ名", "読込ファイル名"
        '保管対象ファイルを読み込む
        If MsgBox("読込フォルダ内のファイル名を読み込みます。", vbOKCancel) = vbOK Then
            'ファイル名を読み込む
            Call ReadFileNames
            Cancel = True
        End If
                
    Case "日時"
        '日時データを入力
        Range("保管[日時]")(r).Value = Left(Range("保管[読込ファイル名]")(r).Value, 12)
            
        Cancel = True
    
    Case "事件番号"
        '事件番号を入力する
        With Sheet21
            '事件番号が入力済みかどうかに応じて処理を行う
            If Range("保管[事件番号]")(r).Value = "" Then
                
                '「事件呼名」を空欄にする
                With Range("保管[事件呼名]")(r)
                    .Validation.Delete
                    .ClearContents
                End With
                
                '「事件」シートを開く
                .Activate
                
                '「保管」シートの「事件番号」と同じ「事件番号」を選択
                If WorksheetFunction.CountIf(.Range("事件[事件番号]"), Range("保管[事件番号]")(r).Value) > 0 Then
                    t = WorksheetFunction.Match(Range("保管[事件番号]")(r).Value, .Range("事件[事件番号]"), 0)
                Else
                    t = 1
                End If
            Else
                '「事件」シートを開く
                .Activate
                
                '対象事件番号を選択する
                If WorksheetFunction.CountIf(.Range("事件[事件番号]"), lngActCase) > 0 Then
                    t = WorksheetFunction.Match(lngActCase, .Range("事件[事件番号]"), 0)
                End If
                
                .Range("事件")(t, 1).Select
            End If
        End With
        
        Cancel = True
        
    Case "事件呼名"
       '事件番号に応じて事件呼名を入力する
        With Sheet21
            '事件呼名を入力する
            If Range("保管[事件呼名]")(r).Value = "" And Range("保管[事件番号]")(r).Value <> "" Then
                '事件の対象テーブル行を取得する
                If WorksheetFunction.CountIf(.Range("事件[事件番号]"), Range("保管[事件番号]")(r).Value) > 0 Then
                    t = WorksheetFunction.Match(Range("保管[事件番号]")(r).Value, .Range("事件[事件番号]"), 0)
                End If
                
                '事件呼名を入力する
                Range("保管[事件呼名]")(r).Value = .Range("事件[事件呼名]")(t).Value
                
                '次の入力列を選択する
                Range("保管[内容]")(r).Select
                
                Cancel = True
            
            End If
        End With

    Case "保管フォルダ名"
        '保管フォルダ名を入力する
        Call InputStoredFolder
            
        If Range("保管[保管フォルダ名]")(r).Value <> "" Then
            '保管ファイル名を入力する
            Call InputStoredFile
                        
            'アンダーラインを設定する
            Range("保管[保管ファイル名]")(r).Font.Underline = False
                                       
            '次の列を選択する
            Range("保管[保管日時]")(r).Select
        End If
        
        Cancel = True

    Case "保管ファイル名"
            
        '保管ファイル名を入力する
        Call InputStoredFile
            
        If Range("保管[保管ファイル名]")(r).Value = "" Then
            
            '次の列を選択する
            Range("保管[保管日時]")(r).Select
        End If
        Cancel = True
    
    Case "保管日時"
        'ファイルを移動し、保管日時を入力する
        If Range("保管[保管フォルダ名]")(r).Value <> "" And _
            Range("保管[保管ファイル名]")(r).Value <> "" Then
                            
            '保管日時の入力状態に応じて処理を行う
            If Range("保管[保管日時]")(r).Value = "" Then
                'ファイルをリネームして移動する
                Call MoveFile
                 
                'ファイル名のアンダーラインを設定する
                If brnMoveFile = True Then
                     With Range("保管[読込ファイル名]")(r).Font
                         .Underline = False
                     End With
                     
                     With Range("保管[保管ファイル名]")(r).Font
                         .Underline = True
                     End With
                End If
        
                '保管日時などを処理する
                If brnMoveFile = True Then
                     
                    '保管日時を記録する
                    Range("保管[保管日時]")(r).Value = Now
                End If
                
            Else
                'ファイルをリネームして元のフォルダに移動する
                Call RstrFile
                 
                'ファイル名のアンダーラインを設定する
                If brnMoveFile = True Then
                     With Range("保管[保管ファイル名]")(r).Font
                         .Underline = False
                     End With
                     
                     With Range("保管[読込ファイル名]")(r).Font
                         .Underline = True
                     End With
                End If
        
                '保管日時などを処理する
                If brnMoveFile = True Then
                     
                    '保管日時を削除する
                    Range("保管[保管日時]")(r).Value = ""
                End If
            End If
        End If
            If brnMoveFile = True Then
                '書式を設定する
                Call FormatTable
            End If
            
            Cancel = True
    
End Select

Call EnblEvents
Exit Sub

HdlErr:
MsgBox "オブジェクトが表示できません。"
Call EnblEvents
Cancel = True
End Sub

ターゲットの行列番号は、それぞれTarget.RowとTarget.columnで求められますが、それはシート上の行列番号であって、テーブル上の行列番号ではありません。それぞれの値をRange(“保管”)の位置を元に修正しています。

ターゲットの列は、Range(“保管”)の行番号0で列番号がターゲットの列番号のセルの値で特定することができます。

この「Range(“保管”)(0, s).Value」で「保管」テーブルのs列のフィールド名が取得できるというのが、テーブルを使うことによる大きなメリットのひとつです。

そんな面倒なことをしなくても、「Select Case s」として、ターゲットの列番号に応じて、処理を分岐させればいいのではないですか?

そう思いますよね。でも、将来、列を追加した場合のことを考えてください。列番号で指示していた場合は、マクロが誤作動することになります。フィールド名で指定しておけば、列が追加になっても正常に作動しますし、もし、そのフィールド名自体が変更になった場合も、エラーが生じるだけで、誤作動はしません。

特定のフィールドの特定の行番号のセルの値は、構造化参照を使って「Range(“保管[番号]”).value」で求めることができます。これもテーブルを使うことによる大きなメリットです。

テーブルを使わなくても、列に範囲名をつけてやれば、同じように列が追加になっても正常に作動するマクロが作れるのではないですか?

そのとおりです。でも、やってみると分かりますが、その範囲名を管理するのは、かなり面倒ですよ。特に複数のシートに同じ「番号」というフィールドがある場合などが大変です。テーブルなら、それを自動でやってくれます。

「Worksheet_Change」プロシージャ

Private Sub Worksheet_Change(ByVal Target As Range)
Dim t As Long, rTmp As Long

'ターゲットのテーブル行・列番号を計算する
r = Target.Row - Range("保管").Row + 1          'テーブル行番号
s = Target.Column - Range("保管").Column + 1    'テーブル列番号

'テーブル行・列番号が入力範囲外の場合は終了する
If r < 1 Or Range("保管").Rows.Count < r Then Exit Sub
If s < 1 Or Range("保管").Columns.Count < s Then Exit Sub

Call DsblEvents

Select Case Range("保管")(0, s).Value
    Case "事件呼名"
        '事件番号を入力
        If Range("保管[事件番号]")(r).Value = "" Then
            '過去の事件呼名を検索して事件番号名を入力
            For rTmp = r - 1 To 1 Step -1
                If Range("保管[事件呼名]")(r).Value = Range("保管[事件呼名]")(rTmp).Value Then
                    Range("保管[事件番号]")(r).Value = Range("保管[事件番号]")(rTmp).Value
                    Exit For
                End If
                Range("保管[内容]")(r).Select
            Next
       End If
    
    Case "内容"
        '保管フォルダ名およびファイル名を入力
        If Range("保管[内容]")(r).Value <> "" Then
            If Range("保管[事件番号]")(r).Value <> "" Then      '事件番号がある場合
                '保管フォルダ名を事件番号に応じて自動入力する
                Call InputStoredFolder
                                                            
                '保管ファイル名を入力する
                Call InputStoredFile
                                
                '次の入力列に移動する
                Range("保管[保管日時]")(r).Select
            Else                                                '事件番号がない場合
                '過去の事件呼名を検索してフォルダ名を入力
                For rTmp = r - 1 To 1 Step -1
                    If Range("保管[事件呼名]")(r).Value = Range("保管[事件呼名]")(rTmp).Value Then
                        Range("保管[保管フォルダ名]")(r).Value = Range("保管[保管フォルダ名]")(rTmp).Value
                    
                        '保管ファイル名を入力する
                        Call InputStoredFile
                        
                        'アンダーラインを設定する
                        Range("保管[保管ファイル名]")(r).Font.Underline = False
                                                    
                        '次の入力列に移動する
                        Range("保管[保管日時]")(r).Select
                        
                        '検索を終了する
                        Exit For
                    End If
                    '次の入力列に移動する
                    Range("保管[保管フォルダ名]")(r).Select
                Next
            End If
            
        End If
        
    Case "保管フォルダ名"
        '事件番号がない場合は保管ファイル名
        If Range("保管[事件番号]")(r).Value = "" Then
            With Sheet21
                '事件のテーブル行を取得
                If WorksheetFunction.CountIf(.Range("事件[事件番号]"), Range("保管[事件番号]")(r).Value) > 0 Then
                    t = WorksheetFunction.Match(Range("保管[事件番号]")(r).Value, .Range("事件[事件番号]"), 0)
                End If
                                                        
                '保管ファイル名を入力する
                Call InputStoredFile
                                                    
            End With
        End If
        
End Select

Call EnblEvents

End Sub

このプロシージャにおいても、まず、ターゲットの行列番号をテーブルの行列番号に変換し、テーブルの列見出しに応じて、処理を行っています。

シートの行列番号と、テーブルの行列番号の関係がいまいちよく分かりません。
見出し行の1行分がずれていると認識するだけでは、ダメですか?

「テーブルの上や左にテーブル以外の行を作らない」ということを守れるのであれば、その考え方でも問題ありません。
とにかくシートの行列番号とテーブルの行列番号は、違うということだけはしっかり認識しておかないと、ずれたデータを参照してしまう可能性があるので気を付けてください。

「Worksheet_SelectionChange」プロシージャ

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'ターゲットのテーブル行・列番号を計算する
r = Target.Row - Range("保管").Row + 1          'テーブル行番号
s = Target.Column - Range("保管").Column + 1    'テーブル列番号

'テーブル行・列番号が入力範囲外の場合は終了する
If r < 1 Or Range("保管").Rows.Count < r Then Exit Sub
If s < 1 Or Range("保管").Columns.Count < s Then Exit Sub

'対象事件番号を記録
lngActCase = Range("保管[事件番号]")(r).Value

'背景色を設定する
With Range("保管").Rows.Interior
        .Pattern = xlNone
End With

With Range("保管").Rows(r).Interior
    .Pattern = xlSolid
    .ThemeColor = xlThemeColorAccent2
    .TintAndShade = 0.799981688894314
End With

End Sub

現在選択しているセルの行全体の背景色を変えています。セルの値を変更するマクロは含まれていないため、イベントの抑制は行っていません。

「ReadFileNames」プロシージャ

Sub ReadFileNames()
Dim x As Integer, v As Long, rTmp As Long
Dim strFolder As String, strFolders As Variant, strFile As String
Dim lngReadCnt As Long
Dim lngMax As Long

Application.StatusBar = "保管するファイルのファイル名を取得しています。"

'入力するテーブル行を取得する
If Range("保管")(1, 1).Value = "" Then
    r = 1
Else
    r = Range("保管").Rows.Count + 1
End If

'読み込みフォルダを取得する
strFolders = Split(Sheet91.Range("読込フォルダ").Value, vbLf)

For x = 0 To UBound(strFolders)
    '読み込みフォルダを選択する
    strFolder = strFolders(x)
    Application.StatusBar = strFolder & "からファイル名を読み込んでいます。"
        
    '読み込みフォルダの存在を確認する
    If Dir(strFolder, vbDirectory) = "" Then
        MsgBox "読み込みファイルのフォルダが見つかりません。", vbExclamation
        Exit Sub
    End If
        
    '読み込みファイルフォルダからファイル名を読み込む
    strFile = Dir(strFolder & "\" & "*.*")
    Do While strFile <> ""
        '同じ名前のファイルが既に読み込まれている場合は、処理しない
        If WorksheetFunction.CountIf(Range("保管[読込ファイル名]"), strFile) > 0 Then _
            GoTo Cont
            
        '最大番号を取得する
        lngMax = WorksheetFunction.Max(Range("保管[番号]"))
                
        '番号を入力する
        Range("保管[番号]")(r).Value = lngMax + 1
        
        '読込フォルダ名を入力する
        Range("保管[読込フォルダ名]")(r).Value = strFolder
        
        '読込フォルダ名にハイパーリンクを設定する
        With Range("保管[読込フォルダ名]")(r)
            .Hyperlinks.Add _
                Anchor:=Range("保管[読込フォルダ名]")(r), _
                Address:=Range("保管[読込フォルダ名]")(r).Value
            With .Font
                .ColorIndex = xlAutomatic
            End With
        End With
        
        '読込ファイル名を入力する
        Range("保管[読込ファイル名]")(r).Value = strFile
        
        '読込ファイル名にハイパーリンクを設定する
        With Range("保管[読込ファイル名]")(r)
            .Hyperlinks.Add _
                Anchor:=Range("保管[読込ファイル名]")(r), _
                Address:=Range("保管[読込フォルダ名]")(r).Value & "\" & Range("保管[読込ファイル名]")(r)
            With .Font
                .ColorIndex = xlAutomatic
            End With
        End With
        
        '日時を入力する
        Range("保管[日時]")(r).Value = Left(Range("保管[読込ファイル名]")(r).Value, 12)
        
        '読み込みファイル数をカウントする
        lngReadCnt = lngReadCnt + 1
        
        '次のテーブル行に移動する
        r = r + 1
Cont:
        '次のファイルを読み込む
        strFile = Dir()
    Loop
    
    x = x + 1
Next
        
'並び替える
Call SortTable

'書式を設定する
Call FormatTable

'読み込み結果のメッセージを表示
If lngReadCnt = 0 Then
    MsgBox "ファイルが見つかりませんでした。"
Else
    MsgBox lngReadCnt & "個のファイルを読み込みました。"
End If

Application.StatusBar = ""

End Sub

各フォルダのファイルの一覧を取得するには、Dir関数を使う方法とFileSystemObjectを使う方法があります。Dir関数を使う方法は、「引数を省略して再度実行すると次のファイルが読みだされる」というのが何となく裏技っぽくって好きになれないのですが、私の環境の場合はFileSystemObjectを使うよりもかなり高速に処理ができましたので、こちらを採用しています。

ファイルの一覧を取得する方法の細部については、こちらをご覧ください。

「MoveFile」プロシージャ

Sub MoveFile()
Dim strReadedFile As String, strStoredFile As String
Dim strErrMsg As String

'完了フラグをリセットする
brnMoveFile = False

'コピー元とコピー先を確認する
Application.StatusBar = "ファイルのコピー元と移動先を確認しています"

'コピー元ファイルが存在することを確認し、コピー元ファイルを取得する
If Dir(Range("保管[読込フォルダ名]")(r).Value & "\" & Range("保管[読込ファイル名]")(r).Value) <> "" Then
    strReadedFile = Range("保管[読込フォルダ名]")(r).Value & "\" & Range("保管[読込ファイル名]")(r).Value
Else
    strErrMsg = Range("保管[読込フォルダ名]")(r).Value & "\" & Range("保管[読込ファイル名]")(r).Value & "が見つかりません。"
    GoTo HdlPrelimErr
End If

'保管フォルダ名が存在することを確認し、移動後ファイルを設定する
If Dir(Range("保管[保管フォルダ名]")(r).Value, vbDirectory) <> "" Then
    strStoredFile = Range("保管[保管フォルダ名]")(r).Value & "\" & Range("保管[保管ファイル名]")(r).Value
Else
    strErrMsg = Range("保管[保管フォルダ名]")(r).Value & "が見つかりません。"
    GoTo HdlPrelimErr
End If

'ファイルを保管フォルダに移動する。
Application.StatusBar = "ファイルを保管フォルダに移動しています。"

'同じ名前のファイルがなければ、ファイル名を変更して事件別フォルダに移動
If Dir(strStoredFile) = "" Then
    On Error GoTo HdlWriteErr
    Name strReadedFile As strStoredFile
    On Error GoTo 0
Else
    strErrMsg = strStoredFile & "と同じ名前のファイルが既にあります。"
    GoTo HdlPrelimErr
End If

Application.StatusBar = ""

'完了フラグをセットする。
brnMoveFile = True

Exit Sub

HdlPrelimErr:
    MsgBox strErrMsg & vbCr & vbCr & "このファイルの移動を中止しました。", vbExclamation
    Application.StatusBar = ""
    Exit Sub
    
HdlWriteErr:
    MsgBox "このファイルを移動できませんでした。" & vbCr & _
        "次のような原因が考えられます。" & vbCr & vbCr & _
        "・ファイルが別のアプロケーションで開かれている。" & vbCr & _
        "・ファイル名に使うことのできない文字が含まれている。" _
        , vbExclamation
    Application.StatusBar = ""
    Exit Sub
    
End Sub

ファイルの移動には、Nameステートメントを使います。フォルダの名前を変えてやれば、移動したことと同じになるという感じです。

ファイルの移動など、ファイルの操作全般については、こちらを参考にしてください。

「RstrFile」プロシージャ

Sub RstrFile()
Dim strReadedFile As String, strStoredFile As String
Dim strErrMsg As String

'完了フラグをリセットする
brnMoveFile = False

'コピー元とコピー先を確認する
Application.StatusBar = "ファイルのコピー元と移動先を確認しています"

'保管ファイルが存在することを確認し、保管ファイル名を取得する
If Dir(Range("保管[保管フォルダ名]")(r).Value & "\" & Range("保管[保管ファイル名]")(r).Value) <> "" Then
    strReadedFile = Range("保管[保管フォルダ名]")(r).Value & "\" & Range("保管[保管ファイル名]")(r).Value
Else
    strErrMsg = Range("保管[保管フォルダ名]")(r).Value & "\" & Range("保管[保管ファイル名]")(r).Value & "が見つかりません。"
    GoTo HdlPrelimErr
End If

'読込フォルダ名が存在することを確認し、読込ファイルを取得する
If Dir(Range("保管[読込フォルダ名]")(r).Value, vbDirectory) <> "" Then
    strStoredFile = Range("保管[読込フォルダ名]")(r).Value & "\" & Range("保管[読込ファイル名]")(r).Value
Else
    strErrMsg = Range("保管[読込フォルダ名]")(r).Value & "が見つかりません。"
    GoTo HdlPrelimErr
End If

'読込フォルダに移動する
Application.StatusBar = "ファイルを読込フォルダに移動しています。"

'同じ名前のファイルがなければ、ファイル名を変更して読込フォルダに移動する
If Dir(strStoredFile) = "" Then
    On Error GoTo HdlWriteErr
    Name strReadedFile As strStoredFile
    On Error GoTo 0
Else
    strErrMsg = strStoredFile & "と同じ名前のファイルが既にあります。"
    GoTo HdlPrelimErr
End If

Application.StatusBar = ""

'完了フラグをセットする。
brnMoveFile = True

Exit Sub

HdlPrelimErr:
    MsgBox strErrMsg & vbCr & vbCr & "このファイルの元のフォルダへの移動を中止しました。", vbExclamation
    Application.StatusBar = ""
    Exit Sub
    
HdlWriteErr:
    MsgBox "このファイルを元のフォルダに移動できませんでした。" & vbCr & _
        "次のような原因が考えられます。" & vbCr & vbCr & _
        "・ファイルが別のアプロケーションで開かれている。" & vbCr & _
        "・ファイル名に使うことのできない文字が含まれている。" _
        , vbExclamation
    Application.StatusBar = ""
    Exit Sub
    
End Sub

一旦移動したファイルを元に戻すマクロも作っておきます。「MoveFile」プロシージャを逆にしただけですが、この機能があるのとないのとでは、使い勝手が全然違います。

「SortTable」プロシージャ

Sub SortTable()
'並び替えを行う

With ListObjects("保管").Sort.SortFields
    .Clear
    .Add Key:=Range("保管[保管日時]"), _
        SortOn:=xlSortOnValues, _
        Order:=xlAscending, _
        DataOption:=xlSortNormal
    .Add Key:=Range("保管[読込フォルダ名]"), _
        SortOn:=xlSortOnValues, _
        Order:=xlAscending, _
        DataOption:=xlSortNormal
    .Add Key:=Range("保管[保管ファイル名]"), _
        SortOn:=xlSortOnValues, _
        Order:=xlAscending, _
        DataOption:=xlSortNormal
    .Add Key:=Range("保管[読込ファイル名]"), _
        SortOn:=xlSortOnValues, _
        Order:=xlAscending, _
        DataOption:=xlSortNormal
End With
With ListObjects("保管").Sort
    .Header = xlYes
    .Orientation = xlTopToBottom
    .SortMethod = xlStroke
    .Apply
End With

End Sub

テーブルの並び替えを行うマクロです。必要に応じ、他のプロシージャから呼び出されます。

「FormatTable」プロシージャ

Sub FormatTable()
Dim varItems As Variant
Dim rTmp As Long

'表示形式を設定する
Range("保管[保管日時]").NumberFormatLocal = "yyyy/m/d h:mm"

'文字色を設定する
With Range("保管")
    For rTmp = 1 To .Rows.Count
        With .Rows(rTmp)
            Select Case Range("保管[保管日時]")(rTmp).Value
                Case ""
                    .Font.ColorIndex = xlAutomatic
                Case Else
                    .Font.ThemeColor = xlThemeColorAccent3
            End Select
        End With
    Next
End With
End Sub

ワークシートが変更された場合に、データの更新日時を更新します。

「InputStoredFolder」プロシージャ

Sub InputStoredFolder()
Dim t As Long
Dim strFolder As String

'保管フォルダ名が入力済みの場合は終了する
If Range("保管[保管フォルダ名]")(r).Value <> "" Then Exit Sub

If Range("保管[事件番号]")(r).Value <> "" Then
    '保管フォルダ名を事件番号に応じて自動入力する
    With Sheet21
        '対象事件のテーブル行を取得
        If WorksheetFunction.CountIf(.Range("事件[事件番号]"), Range("保管[事件番号]")(r).Value) > 0 Then
            t = WorksheetFunction.Match(Range("保管[事件番号]")(r).Value, .Range("事件[事件番号]"), 0)
        End If
        
        '対象事件のデータフォルダを取得する
        strFolder = .Range("事件[データフォルダ]")(t).Value
        
        '保管フォルダ名を入力する
        If InStr(strFolder, ":") <> 0 Then     'フォルダ名に「:」が含まれる場合
            Range("保管[保管フォルダ名]")(r).Value = strFolder & "\" & _
                Replace(Mid(strFolder, InStr(strFolder, ":") + 1), "\", "") & "scan"
        Else                                    'フォルダ名に「:」が含まれない場合
            Range("保管[保管フォルダ名]")(r).Value = strFolder
        End If
    End With
Else
    '保管フォルダ名をダイアログで入力する
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = Sheet91.Range("保管フォルダ")
        If .Show = True Then
            Range("保管[保管フォルダ名]")(r).Value = .SelectedItems(1)
        End If
    End With
End If

'保管フォルダ名にハイパーリンクを設定する
With Range("保管[保管フォルダ名]")(r)
    .Hyperlinks.Add _
        Anchor:=Range("保管[保管フォルダ名]")(r), _
        Address:=Range("保管[保管フォルダ名]")(r).Value
    With .Font
        .ColorIndex = xlAutomatic
    End With
End With

End Sub

保管フォルダ名を入力するマクロです。他のプロシージャから必要に応じ呼び出されます。

「InputStoredFile」プロシージャ

Sub InputStoredFile()
Dim strDate As String, strCase As String, strCont As String, strPrevName As String

'保管ファイル名の各要素を取得する
If Range("保管[事件番号]")(r).Value <> "" Then
    strDate = Range("保管[日時]")(r).Value & Range("保管[事件番号]")(r).Value
Else
    strDate = Range("保管[日時]")(r).Value & "000000"
End If

strCase = Range("保管[事件呼名]")(r).Value
strCont = Range("保管[内容]")(r).Value
strPrevName = Range("保管[読込ファイル名]")(r).Value

'保管ファイル名を入力する
Range("保管[保管ファイル名]")(r).Value = strDate & strCase & " " & _
    strCont & Mid(strPrevName, InStr(strPrevName, "."))

'保管ファイル名にハイパーリンクを設定する
With Range("保管[保管ファイル名]")(r)
    .Hyperlinks.Add _
        Anchor:=Range("保管[保管ファイル名]")(r), _
        Address:=Range("保管[保管フォルダ名]")(r).Value & "\" & Range("保管[保管ファイル名]")(r)
    With .Font
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
End With

End Sub

保管ファイル名を入力するマクロです。他のプロシージャから必要に応じ呼び出されます。

「Sheet21(事件)」モジュール

Option Explicit
Dim r As Long, s As Long

モジュールレベルの変数を宣言しています。

「Worksheet_Activate」プロシージャ

Private Sub Worksheet_Activate()

'対象事件番号を選択
If WorksheetFunction.CountIf(Range("事件[事件番号]"), lngActCase) > 0 Then
    r = WorksheetFunction.Match(lngActCase, Range("事件[事件番号]"), 0)
End If

Range("事件")(r, 1).Select

End Sub

「事件」シートを開いた際に、「保管」シートで選択されていた事件番号を選択します。

「Worksheet_BeforeDoubleClick」プロシージャ

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim t As Long
With Range("事件")
    r = Target.Row - .Row + 1
    s = Target.Column - .Column + 1
    If r = 0 Or r > .Rows.Count Or s > .Columns.Count Then Exit Sub
End With

Call DsblEvents

If s = Range("事件[事件番号]").Column Then
    With Sheet11
        .Activate
        t = ActiveCell.Row - .Range("保管").Row + 1
        '事件番号を入力する
        .Range("保管[事件番号]")(t).Value = Range("事件[事件番号]")(r).Value
        
        '事件呼名を入力する
        .Range("保管[事件呼名]")(t).Value = Range("事件[事件呼名]")(r).Value
    
        .Range("保管[内容]")(t).Select

    End With
    
    Cancel = True
End If
Call EnblEvents
End Sub

事件番号をダブルクリックすると、「保管」シートに事件番号と事件呼名を入力します。

「SortTable」プロシージャ

Sub SortTable()
'デフォルトの順番に並び替える
With ListObjects("事件").Sort.SortFields
    .Clear

    .Add Key:=Range("事件[事件番号]"), _
        SortOn:=xlSortOnValues, _
        Order:=xlAscending, _
        DataOption:=xlSortNormal
End With
With ListObjects("事件").Sort
    .Header = xlYes
    .Orientation = xlTopToBottom
    .SortMethod = xlStroke
    .Apply
End With

End Sub

テーブルを事件番号順に並び替えます。

「FormatTable」プロシージャ

Sub FormatTable()

'ハイパーリンクを設定
For r = 1 To Range("事件").Rows.Count
    Hyperlinks.Add Anchor:=Range("事件[データフォルダ]")(r), _
        Address:=Range("事件[データフォルダ]")(r).Value
Next

End Sub

データフォルダにハイパーリンクを設定します。

「Module11」モジュール

Option Explicit
Public lngActCase As Long       '対象事件番号

パブリック変数を宣言します。

「DsblEvents」プロシージャ

Sub DsblEvents()
With Application
    .ScreenUpdating = False '画面描画を停止
    .Cursor = xlWait 'マウスポインタをウエイトカーソル
    .EnableEvents = False 'イベントを抑止
    .Calculation = xlCalculationManual '計算を手動に
End With
End Sub

イベントの発生を停止させて、マクロ実行中に他のイベント発生してイベントが連鎖するのを防止します。

「EnblEvents」プロシージャ

Sub EnblEvents()
With Application
    .Calculation = xlCalculationAutomatic '計算を自動に
    .EnableEvents = True 'イベントを開始
    .Cursor = xlNormal 'マウスポインタを標準カーソル
    .ScreenUpdating = True '画面描画を開始
End With

End Sub

停止されていたイベントの発生を再開します。

お疲れさまでした。
以上で「ファイル保管」の構造と機能の説明を終わります。

「事件」シートのデータは、事件管理のエクセルファイルからコピーして使うことにします。

その場合は、マクロで自動的に読み込むようにすれば、更新が楽になりますね。

弁護士には、保存したファイルのショートカットを渡すようにしたいのですが、そんなことは可能ですか?

できますよ。そういう、事務所ごとのニーズに応じて機能を追加できるのが、マクロを使ったシステムの魅力です。ぜひ、挑戦してみてください。

コメント

タイトルとURLをコピーしました