White Tiger

Microsoft Excel VBA - 複数のファイルに存在する個人情報を一度に削除する方法

◆概要

このページは、Excel VBAで複数のファイルに存在する個人情報を一度に削除する方法について記載しています。

　Excelファイルにはファイルの作成者に関する情報が残されます。特定のフォルダ配下の全ファイルの個人情報の削除するコードを紹介します。

Option Explicit

Public Sub RefExcelFiles()
    ' 「フォルダ参照」ダイアログボックスを利用して、フォルダを特定する。
    Dim folderName As Variant
    Set folderName = CreateObject("Shell.Application") _
        .BrowseForFolder( _
                    &O0 _
                    , "フォルダ選択" _
                    , &H1 + &H10 _
                    , "デスクトップ")
                    
    ' フォルダが選択されたか否か判別する。
    If folderName Is Nothing Then
        MsgBox "中止します。"
        Exit Sub
    End If
    
    ' 単純なループカウンタ
    Dim lp1&, lp2&
    
    ' FileSystemObjectを作成する
    Dim obj As Object
    Set obj = CreateObject("Scripting.FileSystemObject")
    
    ' 選択されたふぁおるだ配下に存在するファイル名を取り出すための変数
    Dim fileName As String
    Dim fileNames() As String
    ReDim fileNames(0) As String
    
    ' 選択されたフォルダ配下に存在するファイル名を取り出す
    fileName = Dir(folderName.Self.Path & "\*.xls")
    Do While fileName <> vbNullString
        ' ファイル名を配列に取り組む
        ReDim Preserve fileNames(UBound(fileNames) + 1) As String
        fileNames(UBound(fileNames)) = folderName.Self.Path & "\" & fileName
        fileName = Dir()
    Loop
    
    ' すべてのExcelファイルを順次開いて閉じる
    For lp1 = 1 To UBound(fileNames)
        ' Excelファイルを書き込み可能で開く。
        Workbooks.Open fileName:=fileNames(lp1), ReadOnly:=False
        ' 開いたファイルのブック名を取得する
        Dim bookName As String
        bookName = obj.GetFileName(fileNames(lp1))
        ' 開いたファイルの個人情報の削除を可能にする
        Workbooks(bookName).RemovePersonalInformation = True
        ' 開いていたExcelファイルを保存して閉じる
        Application.DisplayAlerts = False
        Workbooks(bookName).Close SaveChanges:=True
        Application.DisplayAlerts = True
        
    Next
    
    ' メモリを解放する
    Erase fileNames
    
    ' オブジェクトを破棄する
    Set obj = Nothing
    Set folderName = Nothing
    
End Sub

Link