メモ:VBAからDiscordにメッセージを送信する

完全に見様見真似のメモ。

ほぼこちらの内容をVBAにしただけ。

アプリケーションからDiscordのチャンネルにメッセージを送る - Qiita

webhookのURLを取得

この辺から取得する。

設定 > テーマ > 詳細設定 >開発者モード のチェックが必要かも

f:id:imihito:20180127232758p:plain

当然ながら、自分がサーバー権限持ってないと取得できない。

ただ、簡単にサーバーは建てられるので、試すだけだけなら非常に楽。

メッセージ送信

MSXML2.XMLHTTPオブジェクトを作ってPOSTするだけ。

失敗した場合は、sendした後にresponseTextにエラーメッセージが入る。

また、openの第三引数varAsyncにTrueを指定しないと、sendで強制停止させられてエラーになる。

Sub SendDiscordMsgSample()
    
    Dim msg As String
    msg = "Hello Discord!!"
    
    Const WEBHOOK_URL = ' 上記で取得したURL文字列
    Dim xhr As Object 'As MSXML2.XMLHTTP60
    Set xhr = VBA.CreateObject("MSXML2.XMLHTTP")
    
    With xhr
        .open "POST", WEBHOOK_URL, True
        .setRequestHeader "Content-Type", "application/json"
        .send "{""content"":""" & msg & """}"
    End With 'xhr
    
End Sub

結果

f:id:imihito:20180127233503p:plain

参考

公式。ちゃんと理解していない。

Discord - Developer Documentation

メモ:PowerShellのAdd-MemberでCOMオブジェクトを拡張する

PowerShellではAdd-Memberコマンドレットを使って、任意のオブジェクトを拡張することが出来る。

この「任意のオブジェクト」にCOMオブジェクトも含まれていたため、動作確認も含めてメモ。

(Add-MemberそのものについてはAdd-Member を極める - 鷲ノ巣が詳しい)

やること

Scripting.Dictionary に TryGetValueという名前のメソッドを追加する。

VBAで書くと以下のようなイメージ

Private dic As Scripting.Dictionary
'...
Function TryGetValue(Key As Variant, ByRef Value As Variant) As Boolean
    Dim isExist As Boolean
    isExist = dic.Exists(Key)
    
    If isExist Then
        Value = dic.Item(Key) 'TODO:Value / Object
    End If
    
    Let TryGetValue = isExist
End Function

PowerShellのコード

# 拡張したCOMオブジェクトを取得する
       # Scripting.Dictionaryをインスタンスして次へ流す
$dic = New-Object -ComObject Scripting.Dictionary |
        # TryGetValue という名前のメソッドを追加
        Add-Member -Name TryGetValue -MemberType ScriptMethod -Value {
            # 引数の設定
            param ([object]$Key, [ref]$Value)

            [bool]$exist? = $this.Exists($Key)
            if ($exist?) {
                $Value.Value = $this.Item($Key)
            }
            Write-Output $exist?
        } -PassThru # 拡張されたオブジェクトを出力

# 準備
$dic.Add('dog', '犬')
$dic.Add('cat', '猫')

# 通常の参照
Write-Host 通常: $dic.Item('dog') # => 通常: 犬

# TryGetValueの動作確認
foreach ($k in @('dog', 'cat','mouse')) {
    $val = ''
    if ($dic.TryGetValue($k, [ref]$val)) {
        Write-Host $k は存在する 値: $val
    } else {
        Write-Host $k は存在しない
    }
}
<#
dog は存在する 値: 犬
cat は存在する 値: 猫
mouse は存在しない
#>

XML生成の練習

やること

以下のXML(HTML)を、PowerShellを使って生成してみる。

<html lang="ja">
  <head>
    <meta charset="utf-8" />
  </head>
  <body>
    <p>Hello <strong>W</strong>orld !!<br />made by PowerShell</p>
  </body>
</html>

f:id:imihito:20180120224636p:plain
生成htmlイメージ

(HTMLとして考えると<!DOCTYPE html>も必要だが後で何とかなるので置いておく)

操作方法の確認も兼ねて以下の二つの方法で作成してみる。

  • System.Xml.XmlWriterを使用する
  • System.Xml.XmlDocumentを使用する

System.Xml.XmlWriter

基本的にWriteStart○○メソッドで要素を書き出して、WriteEnd○○で閉じる。 閉じてない要素は最後で自動で閉じてくれるので省略可。

要素と中身が固定(追記が必要ない)場合はWrite○○Stringを使うと一行で済んで楽になる。

# XML書き出し先
[Text.StringBuilder]$sb = New-Object -TypeName Text.StringBuilder

# XmlWriter設定項目 インスタンス&プロパティ設定
[Xml.XmlWriterSettings]$setXw = 
    New-Object -TypeName Xml.XmlWriterSettings -Property @{
            OmitXmlDeclaration = $true #<?xml version="1.0"~を作成しない
            Indent             = $true #自動整形する
        }

[Xml.XmlWriter]$xw = [Xml.XmlWriter]::Create($sb, $setXw)

# htmlタグ
$xw.WriteStartElement("html")
$xw.WriteAttributeString("lang", "ja")
    
    # headタグ
    $xw.WriteStartElement("head")
        
        $xw.WriteStartElement("meta")
            $xw.WriteAttributeString("charset", "utf-8")
        $xw.WriteEndElement()

    $xw.WriteEndElement()

    # bodyタグ
    $xw.WriteStartElement("body")
        
        $xw.WriteStartElement("p")
            $xw.WriteString("Hello ")
            $xw.WriteElementString("strong", "W")
            $xw.WriteString("orld !!")

            $xw.WriteElementString("br", $null)
            $xw.WriteString("made by PowerShell")


$xw.Close() # 自動タグ閉じ

# 結果確認
$sb.ToString()

# ファイル出力
<#
[string]$savePath = [IO.Path]::Combine(
        [Environment]::GetFolderPath("MyDocuments"),
        "XmlWriter.html"
    )

[IO.File]::WriteAllText(
    $savePath,
    $sb.ToString(),
    [Text.UTF8Encoding]$false
)

explorer.exe $savePath
#>

System.Xml.XmlDocument

Xml.XmlDocumentCreateElementメソッドで要素を作成し、それを各要素にAppendChildで追加していく。

各要素がオブジェクトとして返るので、その分変数が必要。

# 文字列をXml.XmlDocument型にキャスト(型エイリアス[xml])
[xml]$doc = [xml]"<html />"

# htmlタグ
[Xml.XmlNode]$ndHtml = $doc.FirstChild
$ndHtml.SetAttribute("lang", "ja")

# headタグ
[Xml.XmlNode]$ndHead = $ndHtml.AppendChild($doc.CreateElement("head"))
    
    $ndHead.AppendChild(
        $doc.CreateElement("meta")
    ).SetAttribute("charset", "utf-8")

# bodyタグ
[Xml.XmlNode]$ndBody = $ndHtml.AppendChild($doc.CreateElement("body"))

    [Xml.XmlNode]$ndP = $ndBody.AppendChild($doc.CreateElement("p"))
        $ndP.AppendChild($doc.CreateTextNode("Hello ")) > $null
        $ndP.AppendChild($doc.CreateElement("strong")).InnerText = "W"
        $ndP.AppendChild($doc.CreateTextNode("orld !!")) > $null
        
        $ndP.AppendChild($doc.CreateElement("br")) > $null
        $ndP.AppendChild($doc.CreateTextNode("made by PowerShell")) > $null


# 出力準備
[Text.StringBuilder]$sb = New-Object -TypeName Text.StringBuilder
[Xml.XmlWriterSettings]$setXw = 
    New-Object -TypeName Xml.XmlWriterSettings -Property @{
            OmitXmlDeclaration = $true #<?xml version="1.0"~を作成しない
            Indent             = $true #自動整形する
        }

$doc.Save([Xml.XmlWriter]::Create($sb, $setXw))

# 結果確認
$sb.ToString()

# ファイル出力
<#
[string]$savePath = [IO.Path]::Combine(
        [Environment]::GetFolderPath("MyDocuments"),
        "XmlDocument.html"
    )

[IO.File]::WriteAllText(
    $savePath,
    $sb.ToString(),
    [Text.UTF8Encoding]$false
)

explorer.exe $savePath
#>

感想

今回の例のように純粋に生成するだけならXml.XmlWriterを使った方が楽そう。

.NET系だと LINQ to XML を使う方法があるらしいけど、なかなか使う機会が無いので一旦スルー。

メモ:PowerShellで画像をリサイズする

PowerShellを使って画像ファイルを縮小保存する方法のメモ

Bitmap クラス (System.Drawing)

として画像を取り込んだ後、

Bitmap コンストラクター (Image, Int32, Int32) (System.Drawing)

で新しい大きさで画像を作成して保存する。

実際のコード

処理上の決め打ちとして、縦横それぞれ半分($Scale = 0.5)にして「マイピクチャ」にJpegで保存している。

Add-Type -AssemblyName System.Drawing

<#
.Synopsis
画像をリサイズしてマイピクチャにJpegで保存する
#>

# 元の画像ファイル
[string]$Path = "C:\hoge.png"

# 変換サイズ
[double]$Scale = 0.5

# 保存形式
[Drawing.Imaging.ImageFormat]$OutFormat = [Drawing.Imaging.ImageFormat]::Jpeg


# ファイルから画像を読み込み([Drawing.Image]の方が良いけど手抜き)
[Drawing.Bitmap]$srcBmp = [Drawing.Bitmap]::FromFile( $Path )

# 新しい画像サイズ
[int]$newWidth  = $srcBmp.Width  * $Scale
[int]$newHeight = $srcBmp.Height * $Scale

# リサイズした画像
[Drawing.Bitmap]$destBmp = 
    New-Object -TypeName Drawing.Bitmap -ArgumentList $srcBmp, $newWidth, $newHeight

# 出力先のパス
[string]$destPath = 
    [IO.Path]::Combine(
        # 親フォルダ
        [Environment]::GetFolderPath([Environment+SpecialFolder]::MyPictures), 
        
        # 拡張子変更
        [IO.Path]::ChangeExtension(
            [IO.Path]::GetFileName($Path), 
            $OutFormat.ToString()
        )   
    )

# 形式指定で保存(既存ファイル上書き)
$destBmp.Save($destPath, $OutFormat)

# 結果確認
Write-Host 保存先は「 $destPath 」です。

上記コードはPowerShellの特徴であるパイプや自動型変換を使うと、以下のようにも書ける。

Add-Type -AssemblyName System.Drawing

<#
.Synopsis
画像をリサイズしてマイピクチャにJpegで保存する
#>

# 元の画像ファイル
$Path = "C:\hoge.png"

# 変換サイズ
$Scale = 0.5

# 保存形式
$OutFormat = "Jpeg"

$Path | %{
        ([Drawing.Bitmap]$_ | 
                %{New-Object -TypeName Drawing.Bitmap -ArgumentList $_, ([int]($_.Width * $Scale)), ([int]($_.Height * $Scale))}
            ).Save([IO.Path]::Combine(
                [Environment]::GetFolderPath("MyPictures"),
                [IO.Path]::ChangeExtension([IO.Path]::GetFileName($_), $OutFormat)   
            ), $OutFormat)
    }

D&Dでつかるようにする

前項のコードは動作確認にはいいけれど、実際には使いにくいのでドラッグ&ドロップで実行できるようにしてみる。

PowerShellのファイルは通常ドロップを受け付けないため、起動用のバッチファイルと本体のスクリプトの2ファイルを用意する。

PowerShell

以下のコードをps1ファイルとして保存する(文字コードを考えるとPowerShell ISEなど経由で保存の方が良いかも)

<#
.Synopsis
画像をリサイズしてマイピクチャにJpegで保存する
#>

if($args.Length -eq 0) {
    explorer.exe ([Environment]::GetFolderPath("SendTo"))
    exit
}

[string[]]$Path = $args

Add-Type -AssemblyName System.Drawing

# 変換サイズ
[double]$Scale = 0.5
# 保存形式
[Drawing.Imaging.ImageFormat]$OutFormat = [Drawing.Imaging.ImageFormat]::Jpeg

Set-StrictMode -Version Latest
$Path | %{
        ([Drawing.Bitmap]$_ | 
                %{New-Object -TypeName Drawing.Bitmap -ArgumentList $_, ([int]($_.Width * $Scale)), ([int]($_.Height * $Scale))}
            ).Save([IO.Path]::Combine(
                [Environment]::GetFolderPath("MyPictures"),
                [IO.Path]::ChangeExtension([IO.Path]::GetFileName($_), $OutFormat)   
            ), $OutFormat)
    }
explorer.exe ([Environment]::GetFolderPath("MyPictures"))

バッチ

上記ps1ファイルと同じ場所、同じ名前で以下のbatファイルを作成する。

@Powershell -ExecutionPolicy RemoteSigned -File "%~dpn0.ps1" %*

あとはbatファイルに画像ファイルをドロップすればファイルが変換される。

ただし、PowerShellの起動時間が1秒ぐらいかかるので、ちゃっちゃとやりたい場合はC#とかで作ってください。

VBA ListRowを使いやすくするクラス

はじめに

ListRow オブジェクト (Excel)Excelのテーブルの行を表すオブジェクトです。

自分のテーブル(ListObject)の使い方

ワークシート関数のVLOOKUPのようなことをマクロから行うことが多いです。

単純な検索であればVLOOKUPやMATCH+INDEX関数で大丈夫ですが、 複数の列から同時に情報を取得したい、検索条件を柔軟にしたいと言った理由からマクロを使っています。

以上のような操作を行う場合

まずは以下のように対象の列の値の範囲を取得し、検索値がどの行にあるのかを探します。

ListObject.ListColumns.Item(検索する値の列見出し).DataBodyRange
'検索処理...

行番号が見つかったら、以下のように値を取得していきます。

ListObject.ListColumns.Item(取得したい見出し1).DataBodyRange.Item(行番号).Value()
ListObject.ListColumns.Item(取得したい見出し2).DataBodyRange.Item(行番号).Value()
'…

…はい、やけに長ったらしくなりますね。

Withを使えば多少は短くなりますが、ListColumns.Item().DataBodyRange.Item()と結構深く掘る必要があるのが面倒です。

またListColumnと対をなすListRowの方では列見出しから値を取得するすることができません。

ならばListRowから列見出しで値を取得できるようにすればいいじゃないか? という事でそのためのクラスを作成しました。

クラス本体

以下のコードをListRow2という名前のクラスモジュールに貼り付けてください。

Option Explicit

Implements Excel.ListRow
Public Base As Excel.ListRow

'列の番号or見出しから該当するセルを取得する
Function Item(Index As Variant) As Excel.Range
'Attribute Item.VB_UserMemId = 0
    Set Item = getItem(Me, Index)
End Function

Private Function getItem(this As ListRow2, Index As Variant) As Excel.Range
    Set getItem = this.Parent.ListColumns.Item(Index).DataBodyRange.Item(this.Index)
End Function


'以下は既存のメンバーのラップ用
Private Sub ListRow_Delete():   Call Base.Delete: End Sub
        Sub Delete():           Call Base.Delete: End Sub

Private Property Get ListRow_Application() As Application:  Set ListRow_Application = Base.Application: End Property
        Property Get Application() As Excel.Application:    Set Application = Base.Application:         End Property

Private Property Get ListRow_Creator() As XlCreator:        Let ListRow_Creator = Base.Creator:         End Property
        Property Get Creator() As Excel.XlCreator:          Let Creator = Base.Creator:                 End Property

Private Property Get ListRow_Index() As Long:               Let ListRow_Index = Base.Index:             End Property
        Property Get Index() As Long:                       Let Index = Base.Index:                     End Property

Private Property Get ListRow_InvalidData() As Boolean:      Let ListRow_InvalidData = Base.InvalidData: End Property
        Property Get InvalidData() As Boolean:              Let InvalidData = Base.InvalidData:         End Property

Private Property Get ListRow_Parent() As Object:            Set ListRow_Parent = Base.Parent:           End Property
        Property Get Parent() As Excel.ListObject:          Set Parent = Base.Parent:                   End Property

Private Property Get ListRow_Range() As Range:              Set ListRow_Range = Base.Range:             End Property
        Property Get Range() As Excel.Range:                Set Range = Base.Range:                     End Property

使用例

新規ブックに以下のコードと上記のクラスを貼り付けて実行してみてください(既存のブックだと一枚目のワークシートが強制的に書き換えられます)。

なお、コード中で作成しているテーブルの中身は以下の記事を参考に作成しています。

VBA クラスモジュールでExcelのテーブル(ListObject)を操作する - t-hom’s diary

Sub SampleListRow2()
    
    Dim ws As Excel.Worksheet
    Set ws = Excel.ThisWorkbook.Worksheets.Item(1)
    
'テーブルの準備
    'テーブルの中身。配列定数をEvaluate
    tableData = [{"果物","いちご","150";"果物","ばなな","100";"果物","りんご","200";"野菜","キャベツ","150";"野菜","なすび","100";"野菜","レタス","120";"肉","牛肉","300";"肉","豚肉","200";"肉","鶏肉","100"}]
    
    ws.UsedRange.Clear
    With ws.Range("A1").Resize(UBound(tableData, 1), UBound(tableData, 2))
        .Value() = tableData
        
        Dim table As Excel.ListObject
        Set table = ws.ListObjects.Add(xlSrcRange, .Cells)
        
    End With 'ws.Range("A1").Resize(UBound(tableData, 1), UBound(tableData, 2))
    
    With table
        .ShowHeaders = True
        .HeaderRowRange.Value() = VBA.Split("種目,品名,価格", ",")
    End With 'table
    
    
'検索して値の取得
    'りんごについて、種目と価格を知りたい場合
    Dim nameCol As Excel.ListColumn
    Set nameCol = table.ListColumns.Item("品名")
    
    'Matchで手抜き検索
    Dim appleIndex As Long
    appleIndex = Excel.WorksheetFunction.Match("りんご", nameCol.DataBodyRange, 0)
    
    
    '通常の場合
    With table.ListColumns
        Debug.Print "種目", .Item("種目").DataBodyRange.Item(appleIndex).Text '←最後でインテリセンスが切れる
        Debug.Print "価格", .Item("価格").DataBodyRange.Item(appleIndex).Value()
    End With
    
    '自作クラスを使った場合
    Dim appleRow As ListRow2
    Set appleRow = New ListRow2
    Set appleRow.Base = table.ListRows.Item(appleIndex)
    
    Debug.Print "種目", appleRow.Item("種目").Text '←最後までインテリセンスが効く
    Debug.Print "価格", appleRow.Item("価格").Value()
    
    Stop
    
End Sub

その他

Excel.ListRowをImplementsできたのでクラス化しましたが、getItemだけを関数にしてもいい気がします。

こういった「既存のクラスを拡張したい」時に .NET Frameworkの拡張メソッドがうらやましくなります。

VBA用LINQ(作成中)

VBALINQ to Objects 「っぽい」ことができるものを作成中。

OneDrive内の「M_Sample」モジュール

GitHub - imihito/VBALinq(碌に使ったことがないのでちゃんと使えてるかどうか…)

基本方針

やりたいこと

VBAで要素の集合に対してLINQ to Objects 「風」に処理をしたい。

考えないこと

型安全性

ダックタイピング上等、レイトバインディング・リフレクション万歳!の精神。

遅延実行

処理自体の遅延は出来そうだけど、処理が面倒になりそうなので考えない。

処理速度

現状(170820)では、効率の悪い処理をしているがとりあえず置いておく。

モジュール構成案

  • 各種LINQ風メソッドを持つクラス
  • デリゲートとして使うためのクラス群(後述)
  • 補助処理を入れた標準モジュール

VBAに無い要素と代替案

IEnumerableインターフェイス

対象要素が列挙可能かどうかわからないので、とりあえずFor Eachしてみる。

作成するクラスにはVBA.Collectionを内蔵させて、そのイテレータを使ってFor Eachができるようにする。

デリゲート

「実行可能な処理」を示すインターフェイスと、それを実装したクラス群を作成し、そのクラス群を組み合わせて処理を示す形とする。

VBS用配列ラッパークラス

はじめに

VBScriptではVBA.Collectionをインスタンスできないため、複数の要素をまとめて扱うのが少し面倒。

配列を元に、Collection風に使えるVBScript用クラスをざっくり作ってみたのでメモ。

クラス本体

Class ArrayCol
    '内部格納の配列
    Private clsArray 'As Variant
    
    '現在の要素数
    Private UsedCount 'As Long
    
    Private Sub Class_Initialize()
        Call Me.Clear
    End Sub
    
    Public Sub Clear()
        UsedCount = 0
        ReDim clsArray(4)
    End Sub
    
    '配列の下限
    Private Property Get ARRAY_BASE() 'As Long
        ARRAY_BASE = 1
    End Property
    
    '添え字変換
    Private Function UserIndexToRealIndex(Index) 'As Long
        UserIndexToRealIndex = Index - ARRAY_BASE
    End Function
    
    '要素を追加する。
    Public Sub Add(iItem)
        If UBound(clsArray) = UserIndexToRealIndex(UsedCount) Then Call ArrayExpand
        AssignVal clsArray(UsedCount), iItem
        UsedCount = UsedCount + 1
    End Sub
    
    Private Sub ArrayExpand()
        ReDim Preserve clsArray(UBound(clsArray) * 2)
    End Sub
    
    '代入簡略化処理
    Private Sub AssignVal(ByRef o, i)
        If IsObject(i) Then
            Set o = i
        Else
            o = i
        End If
    End Sub
    
    Public Default Property Get Item(ByVal Index) 'As Variant
        AssignVal Item, clsArray(UserIndexToRealIndex(Index))
    End Property
    
    Public Property Let Item(ByVal Index, Value)
        clsArray(UserIndexToRealIndex(Index)) = Value
    End Property
    
    Public Property Set Item(ByVal Index, Value)
        Set clsArray(UserIndexToRealIndex(Index)) = Value
    End Property
    
    Public Property Get Count() 'As Long
        Count = UsedCount
    End Property
    
    Public Sub Remove(ByVal Index)
        Dim i
        For i = UserIndexToRealIndex(Index) To UserIndexToRealIndex(UsedCount - 1)
            AssignVal clsArray(i), clsArray(i + 1)
        Next 'i
        clsArray(UserIndexToRealIndex(UsedCount)) = Empty
        UsedCount = UsedCount - 1
    End Sub
    
    '既存の配列で初期化する。
    Public Sub InitByArray(BaseArray)
        If Not IsArray(BaseArray) Then Err.Raise 5
        
        Me.Clear
        Dim tmp
        For Each tmp In BaseArray
            Me.Add tmp
        Next 'tmp
    End Sub
    
    Public Function ToArray() 'As Variant
        Dim buf:    buf = clsArray
        ReDim Preserve buf(UserIndexToRealIndex(UsedCount))
        ToArray = buf
    End Function
End Class

実装メンバー

Clear

初期化用。

Add

要素を末尾に追加。

Item

添え字で要素を取得。 上記のコードでは添え字は1からはじまる。 範囲外アクセス時の動作は保証しない。

Count

素数。1から数えた場合の数。

Remove

指定された添え字の要素を除去する。 除去したらその分自動で詰める。

InitByArray

指定した配列で初期化する。 適当実装。

ToArray

配列化する。 For Eachの場合や配列そのものが欲しい場合なんかに。

使用例

Option Explicit
Dim myArray 'As ArrayCol
Set myArray = New ArrayCol

With myArray
    .Add 1
    .Add 3.14
    .Add "文字列"
    .Add Now()
    .Add WScript.ScriptFullName
    .Add New ArrayCol
End With    'myArray
MsgBox myArray(1)
Dim buf: buf = ""
Dim tmp
For Each tmp In myArray.ToArray()
    If IsObject(tmp) Then
        buf = buf & TypeName(tmp) & vbCrLf
    Else
        buf = buf & tmp & vbCrLf
    End If
Next 'tmp

MsgBox buf

'Class ArrayCol
'~