• 2009-06 ≪
  • 2009-07
  • 1
  • 2
  • 3
  • 4
  • 5
  • 6
  • 7
  • 8
  • 9
  • 10
  • 11
  • 12
  • 13
  • 14
  • 15
  • 16
  • 17
  • 18
  • 19
  • 20
  • 21
  • 22
  • 23
  • 24
  • 25
  • 26
  • 27
  • 28
  • 29
  • 30
  • 31
  •  ≫ 2009-08

getParam + test

VBSを組むときに値を外出しにしたい
毎回組むのが面倒なので以下のファイルを作成

取得時は

dim param : Set param = CreateObject("Scripting.Dictionary")
error_msg = getParam([ファイル名], param)

使用時は
param("hoge")

以下ソース
-----------------------------------------------------------------------------------------------

'/**
' * @brief 指定ファイルを解析してパラメータ化する
' * @test 読込みファイルに「test=on」と書けば全パラメータを吐き出す
' * @param v_file_read...解析したいファイルの名前
' * @param r_ht...データを格納したいハッシュテーブル("Scripting.FileSystemObject")※参照型
' * @retval エラーが発生したファイル名、行
' * @date 2008/02/15
' * @todo コメント行は配列化
' */
Option Explicit

' パラメータの取得
function getParam(ByVal v_file_read, ByRef r_ht)

dim error_msg : error_msg = ""

Dim wso : Set wso = WScript.CreateObject("Scripting.FileSystemObject")

' 読取ファイルを開く
on error resume next
Dim oFileRead : Set oFileRead = wso.OpenTextFile(v_file_read, 1)
if (0 <> Err.Number) then
getParam = v_file_read
exit function
end if

' 全行解析
Do Until oFileRead.AtEndOfStream

dim line : line = oFileRead.ReadLine

' コメント行は解析しない
if (1 <> instr(line, "/")) and (1 <> instr(line, "'")) and (1 <> instr(line, ";")) and (1 <> instr(line, "#")) then

' パラメータと認識しないとパラメータ化しない
if (1 < instr(line, "=")) then
on error resume next
dim aryLine : aryLine = split(line, "=")

' キーは空白抜きの小文字
dim sKey : sKey = LCase(trim(aryLine(0)))

' 値は空白抜き
dim sValue : sValue = trim(aryLine(1))

' 値がとれない場合は空白とする
if (0 <> Err.Number) then

' エラー
error_msg = line

sValue = ""
end if

' キー追加
r_ht.add sKey, sValue

end if
end if
Loop

' 読取ファイルを閉じる
oFileRead.Close()

' テストコード
if ("on" = r_ht("test")) then

call test_getParam(v_file_read, r_ht)

end if

getParam = error_msg

end function

'/**
' * @brief ### Test ### 要素("Scripting.FileSystemObject")を全てファイルに吐き出す
' * @param v_file_write...解析したファイルの名前
' * @param v_ht...データを格納されたハッシュテーブル("Scripting.FileSystemObject")※参照型
' * @date 2008/02/15
' */
sub test_getParam(ByVal v_file_write, ByVal v_ht)

Dim wso : Set wso = WScript.CreateObject("Scripting.FileSystemObject")

' 出力ファイルを上書きモードで作成する。
Dim oFileWrite : Set oFileWrite = wso.CreateTextFile(v_file_write & "_test.log" , True)

' 出力ファイルに書込み
Dim item
For Each item In v_ht
oFileWrite.WriteLine item & "=" & v_ht.item(item)
Next

' 出力ファイルを閉じる
oFileWrite.Close()

end sub

要素("Scripting.FileSystemObject")を全てファイルに吐き出す

sub test_getParam(ByVal v_file_write, ByVal v_ht)

Dim wso : Set wso = WScript.CreateObject("Scripting.FileSystemObject")

' 出力ファイルを上書きモードで作成する。
Dim oFileWrite : Set oFileWrite = wso.CreateTextFile(v_file_write & "_test.log" , True)

' 出力ファイルに書込み
Dim item
For Each item In v_ht
oFileWrite.WriteLine item & "=" & v_ht.item(item)
Next

' 出力ファイルを閉じる
oFileWrite.Close()

end sub

ユーザーの作成と権限の追加

rem **************************************************
rem ユーザーの作成と権限の追加
rem  パスワードを無期限にするにはaddusers.exe を使う
rem **************************************************

rem "ユーザーID"
set ID=aa

rem "パスワード"
set PW=bb

rem "説明"
set CMT=aaaaa

rem "フルネーム"
set FN=AA

rem "ユーザー作成"
net user %ID% %PW% /add /comment:"%CMT%" /fullname:"%FN%" /expires:never

rem "権限の追加"
net localgroup administrators %ID% /add

pause

横文字苦手

アジェンダ 【agenda】予定。議題。取り組むべき課題
プラクティス 【Best Practice】経験に基づいて有用性が立証された実践項目

セルの保存とオートフィルタの選択

' 保存した横軸の値
Dim m_save_row As Integer

' 保存した縦軸の値
Dim m_save_col As Integer

' オートフィルターの切り替え
Sub modeAutoFilter()
Rows("1:1").Select
Selection.AutoFilter
End Sub

' 選択したセルの値でオートフィルターをかける
Sub selectAutoFilter()
Dim c As String
c = Selection.Cells
Dim row As Integer
col = Selection.Column
Selection.AutoFilter Field:=col, Criteria1:=c

End Sub

' 現在のセル位置を保存
Sub saveCellPos()
m_save_row = Selection.row
m_save_col = Selection.Column
End Sub

' 保存したセル位置へジャンプ
Sub selectCellPos()
If (m_save_row <> 0) Then
Cells(m_save_row, m_save_col).Select
Else
MsgBox ("nothing save data")
End If
End Sub

NEXT ≫

ツール、コード、環境構築の備忘録