系統: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