VBScript上でADODB.ConnectionのSQLに無理言ってDecimal型計算してもらう

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