『VBAプログラミング』知らない間に覗かれたら（開かれたら）メールで通知するExcelファイル。ガスライティング対策にもなります

Private Sub Workbook_Open()
    
    Dim mailObj As Object
    Dim mailFrom As String
    Dim mailFromPassword As String
    Dim mailFromSmtp As String
    Dim mailFromPort As String
    Dim mailCharset As String
    Dim mailTo As String
    Dim mailSubject As String
    Dim mailBody As String
    Dim errNumber As Long
    
    
    '※※は変更してください
    
    '-------------------------------------
    
    '※※yahooメールのアドレス（送信用）
    mailFrom = ""
    
    '※※yahooメールのSMTPパスワード（yahooメールのパスワード）
    'パスワードを数回間違えるとしばらくの間、
    'SMTPサーバーに接続できなくなります
    'もしそうなったら、一定時間（どのくらいかは不明）経過後、
    'yahooアカウントを一旦ログアウト、再度ログインしてお試しください
    mailFromPassword = ""
    
    '※※宛先
    mailTo = ""
    
    '送信用メールのSMTPサーバ（yahooメール以外の場合は変更が必要）
    mailFromSmtp = "smtp.mail.yahoo.co.jp"
    
    '送信用メールのポート番号（yahooメール以外の場合は変更が必要）
    mailFromPort = "465"
    
    'メールの文字コード
    mailCharset = "ISO-2022-JP"
    
    '※※メールのタイトル
    mailSubject = "警告"
    
    '※※メールの本文
    mailBody = "誰かが勝手にファイルを開きました"
    '-------------------------------------
    
    'エラー番号
    errNumber = 0
    
    'CDOのオブジェクトを作成する
    Set mailObj = CreateObject("CDO.Message")
    

    
    With mailObj
        '送信元
        .from = mailFrom
        '宛先
        .to = mailTo
        '件名
        .subject = mailSubject
        '本文
        .TextBody = mailBody
        '文字コード
        .TextBodyPart.Charset = mailCharset
    End With
    
    
    With mailObj.Configuration.Fields
        'SMTPのユーザー名
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = mailFrom
        'SMTPのパスワード
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = mailFromPassword
        '認証方法
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        'SMTPサーバの種類
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        'SMTPサーバ
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = mailFromSmtp
        'STMPの送信用ポート番号
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = mailFromPort
        'SSLを許可
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True

        '設定を更新
        .Update
    End With
    '重要度を変更
    mailObj.Fields.Item("urn:schemas:mailheader:X-Priority") = 1
    mailObj.Fields.Update
    On Error GoTo ErrorTrap
    '送信
    mailObj.Send
    If errNumber = 0 Then
　　　　 '確認用なのでなくてもOK
        'MsgBox "メールを送信しました"
    End If
    '初期化
    Set mailObj = Nothing
    errNumber = 0
    Exit Sub
ErrorTrap:
    errNumber = Err.Number
    MsgBox "エラーの番号:" & Err.Number
    MsgBox "エラーの概要：" & Err.Description
    Resume Next
    

End Sub