VBScript上でADODB.ConnectionのSQLに無理言ってDecimal型計算してもらう
<seed_digits19.vbs>Inputデータ
Dim i
Dim strPathIn
Dim strPathOut
strPathOut = "digits19.txt"
Dim oADOST_R
Dim oADOST_W
Set oADOST_W = CreateObject("ADODB.Stream")
Dim adWriteChar: adWriteChar = 0
Dim adWriteLine: adWriteLine = 1
oADOST_W.Type = 2 '-1--adTypeBinary , 2--adTypeText
oADOST_W.Charset = "Shift-JIS"
oADOST_W.LineSeparator = -1 '-1CrLf , 10 Lf , 13 Cr
oADOST_W.Open
Dim a01
Dim a02
For i = 1 To 63000
a01 = CStr(Int(Rnd()*1000000000000000))
a02 = CStr(Int(Rnd()*10000))
oADOST_W.WriteText a01 & a02, adWriteLine
Next
Dim adSaveCreateNotExist: adSaveCreateNotExist = 1
Dim adSaveCreateOverWrite: adSaveCreateOverWrite = 2
oADOST_W.SaveToFile strPathOut, adSaveCreateOverWrite
oADOST_W.Close
Set oADOST_W = Nothing
MsgBox "処理終了"
<schema.ini>必須
[digits19.txt]
ColNameHeader=False
CharacterSet=oem
Format=CSVDelimited
Col1=Field01 Decimal
<use_decimal.vbs>
Set oFS = CreateObject("Scripting.FileSystemObject")
FileName = oFS.GetAbsolutePathName(".") & "\digits19.txt"
If Not oFS.FileExists(FileName) Then
MsgBox("digits19.txt")
WScript.Quit()
End If
'Set colArg = WScript.Arguments
'If colArg.Count <>1 Then
' WScript.StdErr.WriteLine("引数指定エラー")
' WScript.Quit()
'End If
'keyword = colArg(0)
DBPath = "."
SQLDB = " Driver={Microsoft Text Driver (*.txt; *.csv)};" &_
" DBQ=" & DBPath & ";"
query = "select Str(Field01), Int(Field01/2^32), (Field01 - (Int(Field01/2^32) * 2^32)) from digits19.txt"
Dim oADOST_W
Set oADOST_W = CreateObject("ADODB.Stream")
Dim adWriteChar: adWriteChar = 0
Dim adWriteLine: adWriteLine = 1
oADOST_W.Type = 2 '-1--adTypeBinary , 2--adTypeText
oADOST_W.Charset = "Shift-JIS"
oADOST_W.LineSeparator = -1 '-1CrLf , 10 Lf , 13 Cr
oADOST_W.Open
Set oADOConn = Createobject("ADODB.Connection")
oADOConn.Open(SQLDB)
Set oRS = oADOConn.Execute(query)
'WScript.Echo(oRS.GetString(,,vbTab,vbCrLf))
oADOST_W.WriteText oRS.GetString(,,vbTab,vbCrLf), adWriteLine
oADOConn.Close()
strPathOut = "out_digits19.txt"
Dim adSaveCreateNotExist: adSaveCreateNotExist = 1
Dim adSaveCreateOverWrite: adSaveCreateOverWrite = 2
oADOST_W.SaveToFile strPathOut, adSaveCreateOverWrite
oADOST_W.Close
Set oADOST_W = Nothing
MsgBox "イケるで、しかし!!"
<確認用>Excel VBA
Sub Check_a001()
Dim a01 As Variant
Dim a02 As Variant
Dim a03 As Variant
Dim i As Integer
For i = 1 To 10
a01 = CDec(Range("A" & i).Value)
a02 = Int(a01 / 2 ^ 32)
a03 = a01 - a02 * 2 ^ 32
Range("B" & i).Value = CStr(a02)
Range("C" & i).Value = CStr(a03)
Next
MsgBox "処理終了"
End Sub