1
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 3 years have passed since last update.

Visual BasicAdvent Calendar 2016

Day 15

【VBS】Format関数の@書式を作ってみた

Last updated at Posted at 2016-12-15

はじめに

現在、運用チームに属しているので.NETよりWSH(VBScript)や改修作業でレガシーASPで組むことが多いです。どうしてもPowerShellが馴染めないんですよね。

VBScriptを使用していて不満点が多くあるけど、その中でもFormat関数が貧弱なところがとても不便です。
下記のようにFormatXXXXXと機能ごとに分割されてしまっている。

  • FormatDateTime関数
  • FormatCurrency 関数
  • FormatNumber 関数
  • FormatPercent 関数

FormatDateTime関数は日時を書式文字列化して返却する関数ですが、時刻が0埋めにならないなど使いにくい。また、地域のプロパティに影響してしまうので西暦が2桁になることもありえてしまう。

まだ開発途中ですが、Format関数もどきを出来るだけ短くて使えるものにしようと思っています。

経緯

ファイル名などに区切りなしの日時を付けることはよくあります。
下記のコードにすればいいですね。

Dim strFormattedDate, strDate, dtNow
 
'yyyy/MM/dd HH:mm:ss を yyyyMMddHHmmss に変換
dtNow = Now
strDate = FormatDateTime(dtNow, vbShortDate) & " " & Right("0" & FormatDateTime(dtNow, vbLongTime),8)
strFormattedDate = Replace(Replace(Replace(strDate, "/", ""), ":", ""), " ", "")

今回やりたいのは逆で、yyyyMMddHHmmss を yyyy/MM/dd HH: mm:ss に変換したい。もちろんMID関数などで分割すれば出来るのは分かっているのですが、どうせなら今後のためにも汎用的なFormat関数を作ってみようと思った次第です。
ただあまり本格的なFormat関数を作成すると長くなってしまうので適度なものにしようと思ったところ、VB6 Format 関数の「@」書式を思い出しました。

余談

電子メールが広まって「@」がよく使用されるようになりましたが、それ以前はキーボードにあるけど入力することがほとんど無かったんです。そのようなことに疑問をもって以前書いてみましたので、よろしかったらご覧ください。
@ アットマークにまつわるお話

書式「@」と[は

書式 意味
@ 1つの文字またはスペースを表します。値の中で、@ (アットマーク)に対応する位置に文字が存在する場合は、その文字が表示されます。文字がなければスペースが表示されます。@は、指定した書式の中に表示書式指定文字の ! (感嘆符) がない限り、右から左の順に埋められます。
! 文字を右から左ではなく、左から右の順に埋めていくように指定します。この文字を指定しない場合は、右から左の順に埋められます。
result = Format( "ABC", "@@@@@" )	 '→ "□□ABC" ※□は半角スペース
result = Format( "ABC", "!@@@@@" )	 '→ "ABC□□" ※□は半角スペース

使用例

あるプロセスが本来数分で処理が終わるのですが、何らかの原因でプロセスが残ったまま正常に処理が行われない現象が発生したので、プロセス監視として起動してから10分以上経っていたら警告のメールを送信するみたいなことがありました。

'10分以上前のTest.exeが存在するか +540はグリニッジGMTから日本の場合+9時間
sql = "Select * From Win32_Process Where Name = 'Test.exe'"
sql = sql & " And CreationDate < '" & GetWMIDate(DateAdd("n", -10, Now),"+540") & "'"
Set oClassSet = oService.ExecQuery(sql)

result = 0 '存在なし
'コレクションを解析する。
logString = ""

i = 0
For Each oClass In oClassSet
    If Not IsNull(oClass.CreationDate) Then
        result = 1 '存在あり
        logString = logString & Now & " 開始時刻:" & FormatAt(oClass.CreationDate,"!@@@@/@@/@@ @@:@@:@@")
        logString = logString & ",プロセスID:" & oClass.ProcessId & ",コマンドライン:" & oClass.CommandLine & vbCrLf
        ReDim Preserve aryList(i)
        aryList(i) = oClass.ProcessId
        i = i + 1
    End If
Next

CreationDateではミリ秒+540とグリニッジGMTも含めた値を返してくるので、日時形式でログ出力させたい。「!」があるのは、デフォルトが右から左の順なので左から右の順にするためです。

'2016/12/15 17:37:38 に変換
MsgBox FormatAt("20161215173738.795112+540", "!@@@@/@@/@@ @@:@@:@@")

ソースコード

Function FormatAt(target, formatString)
    Const PlaceMark = "@"
    Dim pattern, replacement, str, place, i, j, flag, length, pad, value	

    FormatAt = target  

    pattern = ""
    replacement = ""
    flag = False
    If Instr(formatString, "!") = 1 Then
        flag = True
        formatString = Mid(formatString, 2) 
    End If

    j = 0
    For i = 1 To Len(formatString)
        place = Mid(formatString, i, 1)
        If place = PlaceMark Then
            j = j + 1 
            pattern = pattern & "(.)"
            replacement = replacement & "$" & j
        Else
            replacement = replacement & place
        End If
    Next

    If j > 0 Then
        length = Len(formatString)
        pad = Space(length)
        value = FormatRegex(target, pattern, replacement, False)
        If flag Then
            FormatAt = Left(value & pad, length)
        Else
            FormatAt = Right(pad & value, length)
        End If
    End If

End Function

Function FormatRegex(target, pattern, replacement, isGlobal)
    Dim reg, matches, match

    FormatRegex = target

    Set reg = CreateObject("VBScript.RegExp")
    reg.Global = isGlobal
    reg.IgnoreCase = True

    reg.Pattern = pattern
    Set matches = reg.Execute(target)
    If matches.Count > 0 Then
        FormatRegex = reg.Replace(target, replacement)
    End If
    Set matches = Nothing

    Set reg = Nothing
End Function

ライセンスっぽいこと

コード改変や配布は自由です。
このツールによる義務/責任を何ら負いません。

最後に

もう少し改良して、0埋めに対応したいと思っています。

VBSのFormatもVal関数と組み合わせれば、もう少しマシになりそうです。
【VBS】Val関数もどきを作ってみた

1
1
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
1
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?