ADODB.Recordset を使用したメモリソート

Rs.Sort = "ソートキー,ソートデータ DESC"
VBScript だけではソートができないので、ADODB.Recordset を使用しています。ここでは、二つのフィールドを使って( SQL の構文で ) ソートしています。

' Null で終了する Unicode 文字列を示します (DBTYPE_WSTR)。
Const adWChar = 130

Dim Rs
Dim strResult

Set Rs = CreateObject("ADODB.Recordset")
Rs.Fields.Append "ソートキー", adWChar,128
Rs.Fields.Append "ソートデータ", adWChar,128
Rs.Open

Rs.AddNew
Rs.Fields("ソートキー").value = "C"
Rs.Fields("ソートデータ").value = "山田1"

Rs.AddNew
Rs.Fields("ソートキー").value = "C"
Rs.Fields("ソートデータ").value = "山田2"

Rs.AddNew
Rs.Fields("ソートキー").value = "A"
Rs.Fields("ソートデータ").value = "田中"

Rs.AddNew
Rs.Fields("ソートキー").value = "B"
Rs.Fields("ソートデータ").value = "鈴木"


' ****************************
' 順ソート + 逆ソート
' ****************************
Rs.Sort = "ソートキー,ソートデータ DESC"

' ****************************
' 先頭に移動
' ****************************
Rs.MoveFirst

strResult = ""
Do while not Rs.EOF

	strResult = strResult & Rs.Fields("ソートキー").Value & " : "
	strResult = strResult & Rs.Fields("ソートデータ").Value & vbCrLf

	Rs.MoveNext

Loop

' ****************************
' 順ソート結果を表示
' ****************************
Wscript.Echo strResult

' ****************************
' 逆ソート + 順ソート
' ****************************
Rs.Sort = "ソートキー DESC,ソートデータ"

' ****************************
' 先頭に移動
' ****************************
Rs.MoveFirst

strResult = ""
Do while not Rs.EOF

	strResult = strResult & Rs.Fields("ソートキー").Value & " : "
	strResult = strResult & Rs.Fields("ソートデータ").Value & vbCrLf

	Rs.MoveNext

Loop

' ****************************
' 逆ソート結果を表示
' ****************************
Wscript.Echo strResult

Rs.Close