Wincc VBS操作txt及SQL2005

系统:Win7 32Bits 旗舰版
wincc: 7.0 sp3英文版

Dim strConnectionString
Dim objConnection
Dim objCommand
Dim strSQL
Dim Rs
Dim sday
Dim smonth
Dim eday
Dim emonth
Dim str1
Dim str2
Dim temp
Dim sqlwhere
Dim msg
Dim CDG, WSH, FilePath
Dim fso, fo, sl
Dim read_temp
Dim OrderFileName
Dim ProductFileName
Dim Source
Dim SourceRow
Dim SourceCell
Dim i, j, k, m
Dim reDateStart, reDateEnd  '日期控件
Dim reordergrid, reworkgrid 'MSHFlexGrid控件
Dim orderwin
Dim sum

Const ForWriting = 2
Const ForReading = 1

Set reDateStart = ScreenItems("DateStart")
Set reDateEnd = ScreenItems("DateEnd")
Set reordergrid = ScreenItems("ordergrid")
Set reworkgrid = ScreenItems("workgrid")
Set orderwin = ScreenItems("InsertWindow")
Set fso = CreateObject("Scripting.FileSystemObject")

OrderFileName = HMIRuntime.ActiveProject.Path + "\Order.csv"
ProductFileName = HMIRuntime.ActiveProject.Path + "\Finish_History.csv"

'Update file for writing SQL Data
Set fo = fso.CreateTextFile(ProductFileName, True)
fo.Close

str1 = Left(reDateStart.Value, 10)'CStr(reDate_start.Year) + "-" + smonth + "-" + sday
str2 = Left(reDateEnd.Value, 10)'CStr(reDate_end.Year) + "-" + emonth + "-" + eday

sqlwhere = "Select * from Finish_History where " + "Start_Date>='" + str1 +"'" + "and Start_Date<='" + str2 + "'" + "Order By Start_Date ASC, Start_Time ASC"
‘Finish_History为wincc自带数据库下自建表
strConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=CC_Tailland_14_07_15_15_19_09R;Data Source=.\WINCC"
Set objConnection = CreateObject("ADODB.Connection")
objConnection.ConnectionString = strConnectionString
objConnection.Cursorlocation = 3
objConnection.Open

Set Rs = CreateObject("ADODB.Recordset")
Set objCommand = CreateObject("ADODB.Command")

objCommand.ActiveConnection = objConnection
objCommand.CommandType = 1
objCommand.CommandText = sqlwhere

'Rs.Open objCommand,,1,3
Set Rs = objCommand.Execute

'Recordset is Null
If Rs.RecordCount = 0 Then
    Set objCommand = Nothing
    Set Rs = Nothing
    Set objConnection = Nothing
    Set reDateStart = Nothing
    Set reDateEnd = Nothing
    Set reordergrid = Nothing
    Set reworkgrid = Nothing
    Set orderwin = Nothing
    Set fso = Nothing
    Set fo = Nothing

    MsgBox "There is no record, please check the query date"
    Exit Sub
End If

'Field name and count
Dim field_sum
Dim field_name()

reworkgrid.Redraw = False 'prevent flashing
reworkgrid.Clear
field_sum = Rs.fields.count

'MsgBox field_sum
Redim field_name(field_sum)
'MsgBox Rs.fields.count
reworkgrid.Cols = 15
reworkgrid.Rows = Rs.RecordCount + 1
'write col and row to wincc for record
HMIRuntime.Tags ("OrderCol").Write field_sum
HMIRuntime.Tags ("OrderRow").Write Rs.RecordCount

reworkgrid.ColAlignment = 4    'The column content is aligned center, center.
reworkgrid.ColAlignmentHeader(0) = 4
reworkgrid.ColAlignmentBand(0) = 4

'section name
reworkgrid.WordWrap = True
reworkgrid.ColWidth(0) = 500 'col 0 width
reworkgrid.TextMatrix(0, 0) = "No."
reworkgrid.ColWidth(1) = 1400 'col 1 width
reworkgrid.TextMatrix(0, 1) = "Start Date"
reworkgrid.ColWidth(2) = 1350 'col 2 width
reworkgrid.TextMatrix(0, 2) = "Start Time"
reworkgrid.ColWidth(3) = 1400 'col 1 width
reworkgrid.TextMatrix(0, 3) = "End Date"
reworkgrid.ColWidth(4) = 1350 'col 2 width
reworkgrid.TextMatrix(0, 4) = "End Time"
reworkgrid.ColWidth(5) = 1000 'col 3 width
reworkgrid.TextMatrix(0, 5) = "Coil No." ' + vbCr + "No."
reworkgrid.ColWidth(6) = 1400 'col 4 width
reworkgrid.TextMatrix(0, 6) = "Coil(mm)" + vbCr + "Thickness"
reworkgrid.ColWidth(7) = 1000 'col 5 width
reworkgrid.TextMatrix(0, 7) = "Coil Color"
reworkgrid.ColWidth(8) = 950 'col 6 width
reworkgrid.TextMatrix(0, 8) = "Order No."
reworkgrid.ColWidth(9) = 1000 'col 7 width
reworkgrid.TextMatrix(0, 9) = "Opertor" + vbCr + "No."
reworkgrid.ColWidth(10) = 1400 'col 8 width
reworkgrid.TextMatrix(0, 10) = "Product" + vbCr + "Length(mm)"
reworkgrid.ColWidth(11) = 1200 'col 9 width
reworkgrid.TextMatrix(0, 11) = "Product" + vbCr + "Pieces"
reworkgrid.ColWidth(12) = 1150 'col 10 width
reworkgrid.TextMatrix(0, 12) = "Complete" + vbCr + "Pieces"
reworkgrid.ColWidth(13) = 1100 'col 11 width
reworkgrid.TextMatrix(0, 13) = "Reject" + vbCr + "Pieces"
reworkgrid.ColWidth(14) = 1500 'col 12 width
reworkgrid.TextMatrix(0, 14) = "Formed/Flat" + vbCr + "sheet"

Set fo = fso.OpenTextFile(ProductFileName, ForWriting)'open for ForWriting

'write first line
temp =     "NO." + "," + "Start_Date" + "," + "Start_Time" + "," + "End_Date" + "," + "End_Time" + "," + "Coil_No" + "," + "Coil_Thickness" + "," + _
        "Coil_Color" + "," + "Order_No" + "," + "Opertor_No" + "," + "Product_Length" + "," + _
        "Product_Pieces" + "," + "Complete_Pieces" + "," + "Reject_Pieces" + "," + "Formed_Flat_sheet"
fo.WriteLine temp

Rs.movefirst

'Set  MSHFlexGrid.DataSource = Rs
'     MSHFlexGrid.Refresh
     'Rs.Close
    i = 1
    j = 1
    k = Rs.RecordCount
    'MsgBox k
    'temp = ""
    
    Do While k
    '    MSHFlexGrid.AddItem(vbTab & rst.fields("Date").value & vbTab & rst.fields("Time").value & vbTab & rst.fields("Coil_no").value _
    '    & vbTab & rst.fields("Coi_Thickness").value & vbTab & rst.fields("Coil_color").value & vbTab & rst.fields("Order_no").value & vbTab & rst.fields("Opertor_no").value _
    '    & vbTab & rst.fields("Product_length").value & vbTab & rst.fields("Product_pieces").value & vbTab & rst.fields("Formed_flat").value & vbTab & rst.fields("Reject_pieces").value)
    '
        'MsgBox rs.fields(3).value
        reworkgrid.TextMatrix(j, 0) = j    'col number
        temp = CStr(j)
        'temp = Rs.fields(0).value
        
        For i = 1 To 15
            reworkgrid.TextMatrix(j, i) = Trim(Rs.fields(i - 1).value)        'col data
            
            'If i <> 14 Then
                temp = temp + "," + Trim(Rs.fields(i - 1).value)
            'End If
        Next
        'write col data
        'MsgBox temp
        fo.WriteLine temp
        Rs.MoveNext
        j = j + 1
        k = k - 1
    Loop

    Rs.Close
    fo.Close
    objConnection.Close
    reworkgrid.Redraw = True 'prevent flashing

Set objCommand = Nothing
Set Rs = Nothing
Set objConnection = Nothing
Set reDateStart = Nothing
Set reDateEnd = Nothing
Set reordergrid = Nothing
Set reworkgrid = Nothing
Set orderwin = Nothing
Set fso = Nothing
Set fo = Nothing