初めに

半年に1回、機器にログインしてパスワード変更を行いshow configコマンドでログを取得しエクセルの対象シートに張り付ける作業がある。
全部で155台あるのですべてをコピー＆ペーストしていると時間もかかりホスト名の見間違えから間違ったシートにコンフィグを張り付けるミスもあった。
そこでこの工程を自動化すれば工数削減もできて、貼り付けミスの防止になると上司に提案した結果、ぜひやってほしいとの許可をいただきマクロを作成してみました。

対象

合計155台のスイッチとルーター

改善前　全てのログをコピー＆ペーストしてエクセルに張り付け
工数1,5~1,75時間
↓
改善後　条件に一致するシートをエクセルの対象シートに張り付けるマクロを作成
工数0.5〜0.75時間
　　　　　
結果
シートの張り間違えがなくなり、約1時間の工数削減に成功

###マクロの機能

取り込み　
条件に一致するテキストtmp1.logを指定したディレクトリから検索してエクセルに取り込む
貼り付け　
コピー元のエクセルファイルに取り込んだシートをコピー先のコンフィグ管理台帳のシート名が一致する指定したセルに張り付け
シート削除　取り込んだシートをすべて削除

使用コード
現場と同じコードを使用するわけにはいかないので、似た環境を作りコードを作成。

##拠点A取り込み

拠点A取り込み

Sub拠点A()
Dim Filename    As String
Dim IsBookOpen  As Boolean
Dim ShCount     As Long
     
With CreateObject("WScript.Shell")    
    .CurrentDirectory = "C:\Users\novel\OneDrive\デスクトップ\その他\ブログ記事\第6回\VBA\拠点別ログ\拠点A\" 'ここで読み込むフォルダを直接指定する   
End With    

Filename = Dir("*tmp1.log*")

Do While Filename <> ""  
    If Filename <> ThisWorkbook.Name Then       
        If IsBookOpen = False Then           
            ShCount = ThisWorkbook.Worksheets.Count                          
            Workbooks.Open (Filename), UpdateLinks:=1           
            Worksheets.Copy After:=ThisWorkbook.Worksheets(ShCount)    
            Workbooks(Filename).Close SaveChanges:=False                                   
        End If        
    End If    
    Filename = Dir()    
Loop
End Sub

Sub 終了表示()
MsgBox "終了しました。"
End Sub

Sub 拠点A取り込み()
    Call 拠点A
    Call 終了表示
End Sub

###マクロ実行結果

##拠点A古いコンフィグ削除と新コンフィグ貼り付け

拠点A古いコンフィグ削除と新コンフィグ貼り付け

Sub 拠点A古いコンフィグ削除と新コンフィグ貼り付け()
   
    Dim book1 As Workbook
    Dim str As String
   
Workbooks.Open "c:\Users\novel\OneDrive\デスクトップ\その他\ブログ記事\第6回\VBA\拠点A.xlsm"

'2020/04/16　次回パスワード変更時は右の日付を選択し、パスワード変更日の日にちに全て置換する。'

'シートの古いコンフィグを削除し最新のコンフィグを張り付け'

Sheets("拠点A-RT-MGC101A").Range("C4:C1000").ClearContents '拠点A-RT-MGC101A
Sheets("拠点A-RT-MGC101A").Range("D2") = Date '最新日付
'コピー元'
Workbooks("貼り付け自動化.xlsm").Worksheets("拠点A-RT-MGC101A_20200416_conf_tm").Range("A1:A1000").Copy _
Workbooks("拠点A.xlsm").Worksheets("拠点A-RT-MGC101A").Range("C4:C1000")
  
Sheets("拠点A-RT-MGC101B").Range("C4:C1000").ClearContents '拠点A-RT-MGC101B
Sheets("拠点A-RT-MGC101B").Range("D2") = Date '最新日付
'コピー元'
Workbooks("貼り付け自動化.xlsm").Worksheets("拠点A-RT-MGC101B_20200416_conf_tm").Range("A1:A1000").Copy _
Workbooks("拠点A.xlsm").Worksheets("拠点A-RT-MGC101B").Range("C4:C1000")

MsgBox "終了しました。"
End Sub

###マクロ実行結果

##シートの削除

シートの削除

Sub sheetDelete() 'シートの削除
    ActiveSheet.Move Worksheets(1)
    Application.DisplayAlerts = False
    For Each mySheet In Worksheets
        If mySheet.Name <> ActiveSheet.Name Then
            mySheet.Delete
        End If
    Next mySheet
    Application.DisplayAlerts = True
End Sub

##今後の課題
今回作成したマクロは新たに拠点に機器を追加する際、VBEにコードを追加する必要がありメンテナンスが属人化しやすくなる。
引継ぎの際、だれでもマクロの運用ができるように運用仕様書を整備しマクロのコードもよりシンプルに出来るようにする。