【VBA】Excelファイルを新規作成してパスワード付きで保存する方法

2024年4月28日

今回は､Excelファイルの新規作成してパスワード付きで保存するマクロを紹介します｡

月次データの作成などでは､毎回新規ファイルにデータを貼り付ける作業があると思います｡

そうした作業は､マクロで一気に自動化することが可能です｡

自動化するサンプルプログラムをお見せするので､参考にしてみてください｡

さらに､作成したファイルを添付したメールを自動作成するプログラムもお見せします｡

Excelファイルを新規作成してパスワード付きで保存するプログラム

Sub SaveNewFileWithPassword()
    Dim filePath As String, fileName As String
    Dim password As String
    
    fileName = InputBox("保存するファイル名を入力してください")
    If fileName = "" Then Exit Sub
    
    ' 保存するファイルパスを作成
    filePath = GetDesktopFolderPath & "\" & fileName & ".xlsx"
    password = "password123"
    
    ' 新しいブックを作成する(Addメソッド)
    With Workbooks.Add
        
        ' ここで作成したファイルにデータを書き込む
        
        
        ' ブックをパスワードで保存する
        .SaveAs fileName:=filePath, password:=password
        
        ' ブックを閉じる
        .Close False
    End With
End Sub
 
Function GetDesktopFolderPath() As String
    
    'Windows Script Hostのオブジェクトを取得
    Dim wsh As Object
    Set wsh = CreateObject("WScript.Shell")
    
    GetDesktopFolderPath = wsh.SpecialFolders("Desktop")
    
End Function

このプログラムを実行すると､上の画像のようにインプットボックスが表示されます｡

作成したいファイル名を打ち込むと､デスクトップ上に自動的にパスワード付きのExcelファイルが作成されます｡

        ' ここで作成したファイルにデータを書き込む

Excelファイルに書き込みたいデータはこの部分で指示をします｡

月次の元データなどからシート上へデータの転記を行ってみてください｡

GetDesktopFolderPathについては､下記記事で解説していますので､ご覧ください｡

さらにOutlookメールに添付させる

Sub SaveNewFileWithPasswordAndMail()
    Dim filePath As String, fileName As String
    Dim password As String
    
    fileName = InputBox("保存するファイル名を入力してください")
    If fileName = "" Then Exit Sub
    
    ' 保存するファイルパスを作成
    filePath = GetDesktopFolderPath & "\" & fileName & ".xlsx"
    password = "password123"
    
    ' 新しいブックを作成する(Addメソッド)
    With Workbooks.Add
        
        ' ここで作成したファイルにデータを書き込む
        
        
        ' ブックをパスワードで保存する
        .SaveAs fileName:=filePath, password:=password
        
        ' ブックを閉じる
        .Close False
    End With
    
    ' 新規メールを作成して添付
    With CreateObject("Outlook.Application").CreateItem(0)
        
        ' 添付ファイルのパスを指定する
        .Attachments.Add filePath
        
        ' メールを表示
        .display
    End With
    
End Sub

Function GetDesktopFolderPath() As String
    
    'Windows Script Hostのオブジェクトを取得
    Dim wsh As Object
    Set wsh = CreateObject("WScript.Shell")
    
    GetDesktopFolderPath = wsh.SpecialFolders("Desktop")
    
End Function

このプログラムでは､最後に新規メールを作成してExcelファイルを添付する内容を追加しています｡

これでメール作成まで､一気に進めることができます｡