제6회 VBA로 컨피그 붙여넣기를 자동화해 공수 삭감을 해 보았다

처음에

반년에 1회, 기기에 로그인해 패스워드 변경을 실시해 show config 커멘드로 로그를 취득해 엑셀의 대상 시트에 붙이는 작업이 있다.
전부 155대이므로 모두를 복사&붙여넣고 있으면 시간도 걸려 호스트명의 잘못에서 잘못된 시트에 컨피그를 붙이는 실수도 있었다.
거기서 이 공정을 자동화하면 공수 삭감도 할 수 있어, 붙여넣기 미스의 방지가 된다고 상사에게 제안한 결과, 꼭 해 주었으면 하는 허가를 받아 매크로를 작성해 보았습니다.

대상

총 155대의 스위치와 라우터

개선 전 모든 로그를 복사하고 붙여넣고 엑셀에 붙여넣기
공수 1,5~1,75시간
↓
개선 후 조건에 일치하는 시트를 엑셀의 대상 시트에 붙이는 매크로를 작성
공수 0.5~0.75시간
　　　　　
결과
시트의 실수 실수가 없어져 약 1시간의 공수 삭감에 성공

매크로 기능

캡처
조건과 일치하는 텍스트 tmp1.log를 지정된 디렉토리에서 검색하여 Excel로 가져 오기

붙여넣기
복사 원본 엑셀 파일로 가져온 시트를 복사 대상 구성 관리 장의 시트 이름이 일치하는 지정된 셀에 붙여 넣기

시트 삭제 가져온 시트를 모두 삭제

사용 코드
현장과 같은 코드를 사용할 수는 없기 때문에 비슷한 환경을 만들어 코드를 작성.

거점 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에 코드를 추가할 필요가 있어 유지보수가 속인화하기 쉬워진다.
인계시, 누구나 매크로의 운용을 할 수 있도록 운용 사양서를 정비해 매크로의 코드도 보다 심플하게 할 수 있도록 한다.