2016-11-14 187 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記錄讀取並寫入文件,使用更少的內存。將數據視爲字符串而不是日期。 – 2016-11-14 19:43:50

+0

我寫入數組的原因是因爲我需要檢查最後一個值....(最後一行,列),所以我不能在這個值之後寫一個逗號.......你能解釋我將如何將日期作爲字符串讀入一個變量? – hfrog713

+0

發佈您的代碼和該字段的數據類型。 – 2016-11-14 20:09:42

回答

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 
相關問題