2016-11-14 13 views
-2

データベースからレコードセットにデータを引き出し、配列に変換してからCSVに書き込んでいます。書式DateTimeからミリ秒のDateTime

データベースには、すべての日付の値がタイムスタンプとしてこの形式で格納されます。

2016-05-04 08:00:00.000000

しかし、私がCSVファイルに書き込むとき、タイムスタンプにはミリ秒は含まれません。

誰もがミリ秒を保存する方法を知っていますか? レコードセットのデータにミリ秒が含まれていますか?

On Error Resume Next 
Dim sPassword 
Dim sUserID 
Dim sDefaultLib 
Dim sSystem 
Dim cs 
Dim rc 
Dim objIEDebugWindow 

sDefaultLib = *library* 
sUserID = *userid* 
sPassword = *password* 
sSystem = *system* 
cs = *connectionString* 

Set con = CreateObject("ADODB.Connection") 
Set data = CreateObject("ADODB.Recordset") 
con.Open cs, sUserID, sPassword 
rc = con.State 

If (rc = 1) Then 
    strQuery = "SELECT * FROM Library.Table FETCH FIRST 15 ROWS ONLY FOR READ ONLY WITH UR" 
    data.CursorLocation = adUseClient 
    data.Open strQuery, con 
    Set filsSysObj = CreateObject("Scripting.FileSystemObject") 
    Dim theYear 
    Dim theMonth 
    Dim theDay 
    Dim mDate 
    mDate = Date() 
    theYear = DatePart("yyyy", mDate) 
    theMonth = Right(String(2, "0") & DatePart("m", mDate), 2) 
    theDate = Right(String(2, "0") & DatePart("d", mDate), 2) 
    mDate = theYear & theMonth & theDate 
    Set csvFile = filsSysObj.OpenTextFile("C:\SampleFile_" & mDate & ".csv", 8, True) 

    columnCount = data.Fields.Count 

    Set i = 0 
    For Each field In data.Fields 
    i= i + 1 
    If (i <> columnCount) Then 
     csvFile.Write Chr(34) & field.Name & Chr(34) & "," 
    Else 
     csvFile.Write Chr(34) & field.Name & Chr(34) 
    End If 
    Next 
    csvFile.Write vbNewLine 
End If 

rowCount = data.RecordCount 
row = 0 

Dim row 
Dim column 
Dim resultsArray 
Dim dateArray 
resultsArray = data.GetRows 

debug "hi" 

i = 0 
Do Until i>5 
    MsgBox(i) 
    i = i + 1 
    'debug "in" 
    'Dim value 
    'Dim dArray() 
    'debug "in" 
    'value = Chr(34) & CStr(data.Fields(17).Value) & Chr(34) & "," 

    'dArray = additem(dArray, value) 
    'data.MoveNext 
    'dateArray = dArray 
Loop 

debug "out" 

For row = 0 To UBound(resultsArray, 2) 
    For column = 0 To UBound(resultsArray, 1) 
    If row = UBound(resultsArray, 2) And column = UBound(resultsArray, 1) Then 
     csvFile.Write Chr(34) & resultsArray(column, row) & Chr(34) 
    Else 
     If column = 0 Then 
     csvFile.Write Chr(34) & formatDate(resultsArray(column, row)) & Chr(34) & "," 
     ElseIf column = 19 Then 
     csvFile.Write Chr(34) & FormatDateTime(resultsArray(column, row),4) & Chr(34) & "," 
     ElseIf column = 18 Then 
     csvFile.Write Chr(34) & formatDate(resultsArray(column, row)) & Chr(34) & "," 
     'ElseIf column = 17 Then 
     'csvFile.Write Chr(34) & formatDate(resultsArray(column, row)) & Chr(34) & "," 
     Else 
     csvFile.Write Chr(34) & resultsArray(column, row) & Chr(34) & "," 
     End If 
    End If 
    Next 
    csvFile.Write vbNewLine 
Next 

csvFile.close 

'----------------------Helper Functions are below----------------------------- 
Sub Debug(myText) 
    'Dim objIEDebugWindow must be defined globally 
    'Call like this "Debug variableName" 
    'Uncomment the next line to turn off debugging 
    'Exit Sub 

    If Not IsObject(objIEDebugWindow) Then 
    Set objIEDebugWindow = CreateObject("InternetExplorer.Application") 
    objIEDebugWindow.Navigate "about:blank" 
    objIEDebugWindow.Visible = True 
    objIEDebugWindow.ToolBar = False 
    objIEDebugWindow.Width = 200 
    objIEDebugWindow.Height = 300 
    objIEDebugWindow.Left = 10 
    objIEDebugWindow.Top  = 10 
    Do While objIEDebugWindow.Busy 
     WScript.Sleep 100 
    Loop 
    objIEDebugWindow.Document.Title = "IE Debug Window" 
    objIEDebugWindow.Document.Body.InnerHTML = "<b>" & Now & "</b></br>" 
    End If 

    objIEDebugWindow.Document.Body.InnerHTML = objIEDebugWindow.Document.Body.InnerHTML & myText & "<br>" & vbCrLf 
End Sub 

Function formatDate(sDate) 
    Dim theYear 
    Dim theMonth 
    Dim theDay 
    Dim formattedDate 

    theYear = Year(sDate) 
    theMonth = Right(String(2,"0") & DatePart("m", sDate),2) 
    theDay = Right(String(2,"0") & DatePart("d", sDate),2) 
    formattedDate = theYear & "-" & theMonth & "-" & theDate 
    formatDate = formattedDate 
End Function 

私が問題を抱えている唯一のフィールドは、レコードセットのフィールド17です。 これは、DB2データベースのタイムスタンプ・データ型です。

+0

配列に書き込む必要はなく、レコードによってRSレコードから読み込んだり、ファイルに書き込んだり、メモリを少なくしたりします。データを日付ではなく文字列として扱います。 –

+0

配列に書き込むのは、最後の値をチェックする必要があるからです(最後の行、列)。その値の後にカンマを書くことができないように.......文字列として日付を変数に読み込みますか? – hfrog713

+0

コードとフィールドのデータ型を転記します。 –

答えて

0

問題は、フォーマットがDB2データベースのタイムスタンプであることでした。私がレコードセットにプルすると、ミリ秒が失われます。私の解決策は、クエリを変更してミリ秒単位で取得し、後でそれを日付に連結する余分な行を追加することでした。下記を参照してください。みんな助けてくれてありがとう。

if(rc = 1) then 
    logFile.write FormatDateTime(Now(), 3) & ": Database connection successful" & vbNewLine 
    logFile.write FormatDateTime(Now(), 3) &": Default Library: " & sDefaultLib & vbNewLine 
    logFile.write FormatDateTime(Now(), 3) & ": Signed into server as: " & sUserID & vbNewLine 
    logFile.write FormatDateTime(Now(), 3) & ": System: " & sSystem & vbNewLine 
    strQuery = "SELECT ws_date, groupcd, userid, firstname, lastname, clientcd, unitcd, categorycd, category, activity, wrktype, subwrktype, step_begin, step_end, report_indicator, report_indicator, count, event_dattim, key_date, key_time, key_milsec, microsecond(event_dattim) FROM *Library.Name* FOR READ ONLY WITH UR" 
    data.CursorLocation = adUseClient 
    data.open strQuery, con 
    if data.EOF then 
     logFile.write FormatDateTime(Now(), 3) & ": The query returned no data" 
     logFile.write FormatDateTime(Now(), 3) & ": ---------------- The script DailyWorkstepReport.vbs file was abended at " & Now() &". There was no worksteps file created. ----------------" & vbNewLine 
     logFile.close 
    end if 
    columnCount = data.Fields.Count 
    columnCount = columnCount - 1 

    Set filsSysObj = CreateObject("Scripting.FileSystemObject") 
    Set csvFile = filsSysObj.OpenTextFile("C:\VBScript\Dailys\" & fname, 8, True) 

    set i = 0 
    for each field in data.Fields 
     i= i + 1 
     if i < columnCount then 
      csvFile.Write chr(34) & field.name & chr(34) & "," 
     elseif i = columnCount then 
      csvFile.Write chr(34) & field.name & chr(34) 
     else 
      exit for 
     end if 
    next 
    csvFile.Write vbNewLine 
else 
    logFile.write FormatDateTime(Now(), 3) & ": Database connection was unsuccessful. Database Connection Return Code: " & rc 
    logFile.write FormatDateTime(Now(), 3) & ": ---------------- The script DailyWorkstepReport.vbs file was abended at " & Now() &". ----------------" & vbNewLine 
    logFile.close 
    csvfile.close 
    wscript.quit 
end if 


dim row 
dim column 
dim resultsArray 
resultsArray = data.GetRows 

dim arrayRows 
arrayRows = ubound(resultsArray, 2) 

if arrayRows <> 0 then 
    logFile.write FormatDateTime(Now(), 3) & ": " & (arrayRows + 1) & " rows were successfully read into the array for file " & fname & vbnewline 


    for row = 0 to UBound(resultsArray, 2) 
     for column = 0 to (UBound(resultsArray, 1) - 1) 
      if row = Ubound(resultsArray, 2) and column = (ubound(resultsArray, 1) - 1) then 
       csvFile.Write chr(34) & resultsArray(column, row) & chr(34) 
      else 
       if column = 0 then 
        csvFile.Write chr(34) & formatDate(resultsArray(column, row)) & chr(34) & ","    
       elseif column = 19 then 
        csvFile.Write chr(34) & FormatDateTime(resultsArray(column, row),4) & chr(34) & "," 
       elseif column = 18 then 
        csvFile.Write chr(34) & formatDate(resultsArray(column, row)) & chr(34) & "," 
       elseif column = 17 then 
        Dim fDate 
        fDate = formatDate(resultsArray(column, row)) & " " & FormatDateTime(resultsArray(column, row),4) & ":" & second(resultsArray(column,row)) & "." & resultsArray((ubound(resultsArray, 1)), row) 
        csvFile.Write chr(34) & fDate & chr(34) & ","    
       else 
        csvFile.Write chr(34) & resultsArray(column, row) & chr(34) & ","    
       end if 
      end if 
     next 
     csvFile.Write vbNewLine 
    next 
    logfile.write FormatDateTime(Now(), 3) & ": " & (row) & " rows have been written to " & fname &vbNewLine 
else 
    logFile.write FormatDateTime(Now(), 3) & ": There was no data in the query results array for file " & fname & vbNewLine 
    logFile.write FormatDateTime(Now(), 3) & ": ---------------- The script DailyWorkstepReport.vbs file was abended at " & Now() &". ----------------" & vbNewLine 
    logfile.close 
    csvfile.close 
    wscript.quit 
end if 

csvFile.close 
logfile.write "---------------- DailyWorkstepReport.vbs script successfully ended at " & Now() & "----------------" & vbNewLine 
logfile.close 
wscript.quit 


REM ----------------------Helper Functions are below----------------------------- 
Sub Debug(myText) 
    'Dim objIEDebugWindow must be defined globally 
    'Call like this "Debug variableName" 
    'Uncomment the next line to turn off debugging 
    'Exit Sub 

    If Not IsObject(objIEDebugWindow) Then 
     Set objIEDebugWindow = CreateObject("InternetExplorer.Application") 
     objIEDebugWindow.Navigate "about:blank" 
     objIEDebugWindow.Visible = True 
     objIEDebugWindow.ToolBar = False 
     objIEDebugWindow.Width = 200 
     objIEDebugWindow.Height = 300 
     objIEDebugWindow.Left = 10 
     objIEDebugWindow.Top  = 10 
     Do While objIEDebugWindow.Busy 
      WScript.Sleep 100 
     Loop 
     objIEDebugWindow.Document.Title = "IE Debug Window" 
     objIEDebugWindow.Document.Body.InnerHTML = "<b>" & Now & "</b></br>" 
    End If 

    objIEDebugWindow.Document.Body.InnerHTML = objIEDebugWindow.Document.Body.InnerHTML & myText & "<br>" & vbCrLf 
End Sub 

function formatDate(sDate) 
    Dim theYear 
    Dim theMonth 
    Dim theDay 
    Dim formattedDate 

    theYear = Year(sDate) 
    theMonth = Right(String(2,"0") & DatePart("m", sDate),2) 
    theDay = Right(String(2,"0") & DatePart("d", sDate),2) 
    formattedDate = theYear & "-" & theMonth & "-" & theDate 
    formatDate = formattedDate 
end function 
関連する問題