なんちゃってSESエンジニアがExcel VBAで快適な朝をデザインする

Posted on2020年10月19日 Edit on2022年5月12日投稿者: バイリンガルネットワークエンジニア　のぽた

SESの朝は無駄が多い

※纏めはqiitaにあります。このブログは、紆余曲折も含め記載してますので冗長です。

※全部フィクションですよ！

おはようございます。
僕はSESです。
今日も古めかしいPCを使い、
Windowsの標準ソフトと時代錯誤のサービスを使い倒しながら、
遅延だらけのイントラ回線の中で仕事をしていきたいと思います。

Trelloってなんだ？

朝やる事

朝やる事を時系列で書いてみます。
・PCの電源を入れる
・画面ロックのパスワードを入力
・必要なソフトを立ち上げる
・無駄な常駐ソフトを落とす
・出勤したことを伝えるメールを送る（在宅勤務が増えたので）
・メールに目を通す
・メールで対応しないといけないものに返答していく

書き始めると山ほどあるのでこの7人の侍にしておきますか

ではこの7つの処理を自動化・・・
していきたいのですが、
「PCの電源を入れる」「画面ロックのパスワードを入力」は割愛します。
多分解決策は以下です。
ただ、SES的なPCだと権限が制御されてるので出来ない可能性が高く割愛です。
　PCの電源を入れる＝ WOL(Wake On LAN)
　画面ロックPWD自動化＝自動サインインを設定 or 画面ロックを設定解除

Slackってなんですか？

よって、この5人のスタメンで戦います！

1番：必要なソフトを立ち上げる
2番：無駄な常駐ソフトを落とす
3番：出勤したことを伝えるメールを送る（在宅勤務が増えたので）
4番：メールに目を通す
5番：メールで対応しないといけないものに返答していく

ちなみにバスケでは、ポジションを番号で呼びます。（野球も一緒だよね）
1番：ガード
2番：シューティングガード
3番：スモールフォワード
4番：パワーフォワード
5番：センター
最近では違う呼称かな。
故障しないようにね！

Macをスタバで使うって都市伝説ですよね？

1番：必要なソフトを立ち上げる

いや、Windowsのスタートアップを使えば良いじゃん！
その通りです。
ですが、スタートアップで必要なソフトが一気に立ち上がると、
めちゃめちゃ重くならないですか？？？
特にSESだと
・PCのスペックが悪い
・立ち上げないといけないソフトが多い
ので大渋滞が起きます。
また、社内ネットワークを使っていると、

朝の回線は大混雑

しているんですよね。
なぜかというと、各拠点の人が
朝の同じ時間にPCを立ち上げるからです。

低スペックPC上でもソフトが沢山立ち上がるし
回線も混雑してるんで

なんかPCがフリーズするような感じになります。

毎朝そんな負荷をPCにかけるのは良くないので、
立上げをデザインします。（←言ってみたかっただけ）

まぁ一回設定すれば、毎朝の立ち上がりが快適になるので、
自分はそれを眺めて自己満足に浸っています。
良い気分で朝を始められますよ！

Google SuiteがGoogle Workplaceになった？
どっちも知らねーよ！！！

自動立上げをExcel VBAで実施

Excel VBAを使って立上げをデザインします。
【使う技】
　・Sleep API関数
　・ThisWorkbookのopenプロシージャ

【事前説明】
　Excel VBAには、”Excelを立ち上げた時に処理を実行する”というプロシージャがあります。
　それが”ThisWorkbookのopenプロシージャ”です。
　私はこれを使っています。
　利点は、実行タイミングをデザインできる事です。
　デフォルトのWindowsスタートアップだと、Windowユーザーへログインしたときに自動実行されますが、この手法だと、excelを立ち上げなければ実行されないので、実行タイミングを”よりデザイン”できます。
　（excelを立ち上げるめんどくさい作業が1つ増えた。とは表現しません☺）

コード（Excel VBA）

Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'APIを宣言

Private Sub Workbook_Open()

  '処理を実行していいか訊きます。excelは業務中に何度か立ち上げ直す可能性があるため
  '処理を実行するかしないか、デザインします。
  If MsgBox("wanna bootup?", vbYesNo) = vbYes Then

     'software open
     Shell "実行したいソフトウェアのフルパス" '自分はClipboard管理ソフトなどを立ち上げます

     'SES定番のメーラー、outlookを立ち上げます。
     Shell "C:\Program Files (x86)\Microsoft Office\Office16\OUTLOOK.EXE"

    'ここで7秒間処理を止めます。
outlookの完全立ち上がりを待ちます
     Sleep 7000 '単位はミリ秒です。
 
    'browserベースのサービスを立ち上げます。
     '⇩これは汎用的な実行技で、URLを入力すると、デフォルトブラウザ（SESではEdge）が立ち上がります。。
     CreateObject("Shell.Application").ShellExecute "対象URL"
     '⇩これは、立ち上げるBrowserを指定しています。下記ではChrome指定です）
     CreateObject("WScript.Shell").Run ("chrome.exe -url " & "https://www.youtube.com/channel/UChSOjYK2JGEnErS1FXglALQ")
     'メッセージを表示させて、朝忘れそうな処理などをリマインドします。
     MsgBox "今日の予定を確認しよう。昨日の勤怠報告がまだならやっておこう"

  Else
    'do nothing
  End If

End Sub

これをご自身でカスタマイズすると、快適な朝がデザインできます。
自分はその日が「月末か月初か？」を読み取って、月末月初に必要な処理も記述しています。

2番：無駄な常駐ソフトを落とす

次は、無駄な常駐ソフトを落とします。
SESでありがちです。
まず私が朝一で落とすのは以下2つです。
・Microsoft Teams
・Skype for Business
SES的な皆さんも、自分で必要ないなと思ったソフトは落としましょう💛
というのも、SESのPCは低スペックです。
なるべくメモリやプロセスは空けておくと、多少動いてくれます。
これもデザインですね。

コードはOffice TANAKA先生のコードを参考にmicrosoft Teamsを落とすコードを書きました、が・・・。

Sub Sample3()
    Dim WD, task
    Set WD = CreateObject("Word.Application")
    For Each task In WD.Tasks
        If task.Visible = True And <strong>InStr</strong>(task.Name, "Microsoft Teams") &gt; 0 Then
           If MsgBox(task.Name &amp; vbCrLf &amp; "を終了させますか？", 36) = vbYes Then
            task.<strong>Close</strong>
           End If
        End If
    Next
    WD.Quit
    Set WD = Nothing
End Sub

【問題点】
　・常駐側（プロセス自体）は終了しない（開いてるWindowは消えるが）
　・動きが安定しない
　　（稀に、全然処理が終了せず、変なメッセージが出る）

何にしろ、プロセス自体が終了出来なかったので、違う方法をとります。
VBA Create 「VBAでIE操作「Internet Explorerのプロセスを強制終了」する」

Public Sub Call_TaskKill()
    Dim obj As Object
     
    Set obj = CreateObject("WScript.Shell")
    obj.Exec ("taskkill.exe /F /IM Teams.exe")
    obj.Exec ("taskkill.exe /F /IM lync.exe")
End Sub

結論、上記のコードで達成できました。
無事、常駐側（プロセス自体）事終了する事が出来ました。
今回終了したいアプリ
　・Microsoft Teams
　・Skype for Business 2016

Teamsの方は、実行ファイルの名前がすぐわかったので問題なかったのですが、Skype for Businessの方は分かりませんでした。

Teamsは分かったんですが・・・。

Skypeは、ショートカットが叩いてる実行ファイルを確認できませんでした。
ただ、ググった所、lync.exeかもしれないなと思ったら、ドンピシャでした。

他にもSkypeのクローズ（Kill task）は困ってる人が沢山いるみたいで、ググったら色々ヒットして面白かったです。
windowsはバージョン違いやMicrosoft 365(旧オフィス365)など色々あるし、SkypeはSkypeもあるしSkype for Businessもあるし、混乱しますよね。

exeファイル名の探し方も実行しましたが、SES的なPCだと権限が制限されてるのか、発見できませんでした。
（現在フォルダ位置が悪いだけかも）

3番：出勤したことを伝えるメールを送る

【手順】
・まず先にoutlookでテンプレートメールを作成しておきます。
・そして、それをVBAで呼び出します。

コード

'朝、在宅勤務になり勤務開始のメールを送らないといけないので、outlookのメールテンプレートを表示します。
Viva SES！
Dim objItem As Object
Set objItem = CreateItemFromTemplate("C:\Users\***勤務開始テンプレート.oft")
objItem.Display

これだけです。

4番：メールに目を通す

毎日大量のメールが届く。
そして自分が対応するべきメールはそれほどない。
それがSESです。

【やりたい事】
・自分が対応すべきメールをPICKアップする

【やり方】
・宛先でフィルタする
・件名でフィルタする
・内容でフィルタする
・分類項目でフィルタする
・フラグでフィルタする

【コード】
とりあえず、フィルタしたい項目の取得までを記載します。
　事前準備
　　対象としたいメールをoutlookで選択しておきます。
　　複数選択可能です。
　　outlookを「スレッド化」している人は、スレッドを展開しておかないと一番最後のメールしか読み取りません。
　　（スレッド内の全てのメールを読み取るようにコーディングしていたんですが、まだうまく出来ていません）

 Sub getBasicEmailInfo()

    Dim outlookObj As Outlook.Application
    Dim objParentFolder As Outlook.Folder ' parent
    Dim pastingStartPointRow As Long
    pastingStartPointRow = 1
    Dim myNameSpace As Object
    Dim oBjMailitem As Object
    Dim InboxFolder, i, n, k, attno As Long
    Dim myExplr As Outlook.Explorer
    Dim flagbox As String

   'pre-preparation
    Set outlookObj = CreateObject("Outlook.Application")
    Set myNameSpace = outlookObj.GetNamespace("MAPI")
    Set InboxFolder = myNameSpace.GetDefaultFolder(6)
    Set myExplr = outlookObj.ActiveExplorer
    
    
    'For文始まるよ
    For i = 1 To myExplr.Selection.Count
            
        'outlook mailitemオブジェクトを取得します。
        'reference : https://docs.microsoft.com/en-us/office/vba/api/outlook.mailitem
        Set oBjMailitem = myExplr.Selection.Item(i)
        
        '受信者を取得
        Cells(pastingStartPointRow, 1).Value = oBjMailitem.ReceivedByName
        '送信者のメールアドレスを取得
        Cells(pastingStartPointRow, 2).Value = oBjMailitem.SenderEmailAddress
        '受信日時を取得
        Cells(pastingStartPointRow, 3).Value = oBjMailitem.ReceivedTime
        'メール件名を取得
        Cells(pastingStartPointRow, 4).Value = oBjMailitem.Subject
        'メール本文を取得
        Cells(pastingStartPointRow, 5).Value = oBjMailitem.Body
        'フラグリクエスト（フラグの内容）を取得
        Debug.Print "FlagRequest : " & oBjMailitem.FlagRequest

        'flag種類の確認して日本語に置き換えます 0:フラグなし、1:完了フラグ、2:フラグあり
        If oBjMailitem.FlagStatus = 0 Then
            flagbox = ""
        ElseIf oBjMailitem.FlagStatus = 1 Then
            flagbox = "flag完了"
        ElseIf oBjMailitem.FlagStatus = 2 Then
            flagbox = "flagあり"
        End If
        Cells(pastingStartPointRow, 6).Value = flagbox
        '分類項目を取得
        Cells(pastingStartPointRow, 7).Value = oBjMailitem.Categories
        
        pastingStartPointRow = pastingStartPointRow + 1
        
    Next i
    
    '''---コード7｜セットした変数を解除
    Set outlookObj = Nothing
    Set myNameSpace = Nothing
    Set InboxFolder = Nothing


End Sub

outlookの分類項目について

これのことです。