Timing Shift Project Help

Printable View

Aug 15th, 2012, 10:48 AM
sbarber007

Timing Shift Project Help

Hi All

I got project in mind but need your experts out there to see if its possiable

What i would like is between 6.30am - 14.30pm the data in text1.text and save it to text file during that time to file "SHIFT 15-08-12 6.30 - 14:30.TXT" and at 14:30pm - 22:30pm the data in text1.text and save it to text file during that time to file "SHIFT 15-08-12 14:30pm - 22:30pm .TXT" and at 22:30 - 06:30am the data in text1.text and save it to text file during that time to file "SHIFT 15-08-12 22:30 - 06:30am .TXT"

Is this poss.

Regards

Steve
Aug 15th, 2012, 10:59 AM
DataMiser

Re: Timing Shift Project Help

Yes it is possible, not enough info to give you much direction but should not be to hard to do.
Aug 15th, 2012, 04:21 PM
sbarber007

Re: Timing Shift Project Help

Basicly I want add to the script that you see before
at the bottom of script marked in red below

Private Sub Form_Load()
Dim textfile As String

Open "C:\users\administrator\dirnames.txt" For Input As #1
Do While Not EOF(1)
Input #1, textfile
FolderCreator.Combo1.AddItem (textfile)
Loop
Close #1

' Show Date on main screen.
'Label3.Caption = DateValue(Now)

' Fire Rx Event Every Two Bytes
MSComm1.RThreshold = 1 ' Is this correct
' When Inputting Data, Input 2 Bytes at a time
MSComm1.InputLen = 13 ' Is this correct

' 9600 Baud, No Parity, 8 Data Bits, 1 Stop Bit
MSComm1.Settings = "9600,N,8,1"
' Disable DTR
MSComm1.DTREnable = False

' Open COM1
MSComm1.CommPort = 1
MSComm1.PortOpen = True
MSComm1.InBufferCount = 0 ' Do I need this
End Sub

Private Sub MSComm1_OnComm()

'
' Assumes RTHreshold Property is set to a value > 0
' (Recommended value is 1)
'
Static strBuffer As String
Dim strData As String
Dim strRX As String
Dim boComplete As Boolean
Select Case MSComm1.CommEvent
Case comEvReceive
strData = MSComm1.Input
strBuffer = strBuffer & strData
Do
If Len(strBuffer) >= 13 Then
strRX = Mid$(strBuffer, 1, 13)
'
' rest of your code goes here - strRX contains the 13 characters sent
' After you've done all your processing add the following code

' START OF MY SCRIPT

Label8.Caption = strData
'MSComm1.Output = strData
Dim wshThisShell As WshShell
Dim lngRet As Long
Dim strShellCommand As String
Dim strBatchPath As String
'label8.caption = ""
Set wshThisShell = New WshShell
strBatchPath = "c:\deletevert.bat"
'the path for the batch file you're using
strShellCommand = Chr$(34) & strBatchPath & Chr$(34)
'the ridiculous number of quotation marks is necessary
'when there is a space in one or more of the folder names
lngRet = wshThisShell.Run(strShellCommand, vbNormalFocus, vbTrue)
'set 3rd argument above to vbFalse for asynchronous
'execution of the batch file.
'label8.caption = ""
'label9.caption = ""
If Dir$("e:\" & strData, vbDirectory) = "" Then

Label9.Caption = "Directory does not exist."
MkDir "e:\" & strData
MkDir "e:\" & strData & "\" & FolderCreator.Combo1.List(0)
MkDir "e:\" & strData & "\" & FolderCreator.Combo1.List(1)
MkDir "e:\" & strData & "\" & FolderCreator.Combo1.List(2)
MkDir "e:\" & strData & "\" & FolderCreator.Combo1.List(3)
MkDir "e:\" & strData & "\" & FolderCreator.Combo1.List(4)
MkDir "e:\" & strData & "\" & FolderCreator.Combo1.List(5)
MkDir "e:\" & strData & "\" & FolderCreator.Combo1.List(6)
MkDir "e:\" & strData & "\" & FolderCreator.Combo1.List(7)
MkDir "e:\" & strData & "\" & FolderCreator.Combo1.List(8)
MkDir "e:\" & strData & "\" & FolderCreator.Combo1.List(9)
MkDir "e:\" & strData & "\" & FolderCreator.Combo1.List(10)
MkDir "e:\" & strData & "\" & FolderCreator.Combo1.List(11)
MkDir "e:\" & strData & "\" & FolderCreator.Combo1.List(12)
MkDir "e:\" & strData & "\" & FolderCreator.Combo1.List(13)
MkDir "e:\" & strData & "\" & FolderCreator.Combo1.List(14)

Shell ("net use Z: " & "\\ENDOFLINE\STORAGE\" & strData & " /persistent:yes")
Shell ("net use Z: " & "\\ENDOFLINE\STORAGE\" & strData & " /persistent:yes")
MSComm1.Output = strData

Else

ViewRejects.ViewList.AddItem strData & " REJECTED ON " & Now
Label5.Caption = ViewRejects.ViewList.ListCount
Label9.Caption = "Directory exists."
Shell ("net use Z: " & "\\ENDOFLINE\STORAGE\" & strData & " /persistent:yes")
Shell ("net use Z: " & "\\ENDOFLINE\STORAGE\" & strData & " /persistent:yes")
MSComm1.Output = strData
i want to create a text file here called "SHIFT 06:30 - 14:30.txt" to capture the strdata from every engine between this time and then create another text file call "SHIFT 14:30 - 22:30.txt" to capture the strdata from every engine between this time and then create another text file call "SHIFT 22:30 - 06:30.txt" to capture the strdata from every engine between this time I know how to create the text file with data the bit i dont understand is setting the time limits for each shift.
Open "e:\REJECTS.txt" For Append As #1
' For I = 0 To Lis't1.ListCount - 1
Print #1, strData & " REJECTED ON " & Now
' Next
Close #1

Open "e:\" & strData & "\REJECTS.txt" For Append As #2
' For I = 0 To Lis't1.ListCount - 1
Print #2, strData & " REJECTED ON " & Now
' Next
Close #2
End If
End If
' THE REST OF YOUR SCRIPT got compile error below

If Len(strBuffer) = 13 Then
strBuffer = ""
boComplete = True
Else
strBuffer = Mid$(strBuffer, 14)
End If
Else ' I get Compile Error Else Without IF
boComplete = True
End If
Loop Until boComplete = True
End Select
End Sub

Kind Regards

Steve
Aug 15th, 2012, 05:47 PM
Doogle

Re: Timing Shift Project Help

First off, there's no 'Script' here it's VB6 Code. Secondly, why are you messing around with strData when what you've received is in strRX ?
Aug 16th, 2012, 01:18 AM
sbarber007

Re: Timing Shift Project Help

HI

@Doogle

Sorry I made error there I missed that I will change it thanks
Aug 17th, 2012, 06:46 PM
Doogle

Re: Timing Shift Project Help

I read your Visitor message, but where is the problem now ?
Aug 18th, 2012, 03:00 AM
sbarber007

Re: Timing Shift Project Help

Hi Doogle
Need ponting in the right direction.

I want to create a text file here called "SHIFT 06:30 - 14:30.txt" to capture the strdata from every engine between this time 06:30am - 14:30pm and then create another text file call "SHIFT 14:30 - 22:30.txt" to capture the strdata from every engine between this time 14:30pm - 22:30pm and then create another text file call "SHIFT 22:30 - 06:30.txt" to capture the strdata from every engine between this time 22:30pm - 06:30am I know how to create the text file with data the bit i dont understand is setting the time limits for each shift.

Regards

Steve
Aug 18th, 2012, 04:53 AM
Doogle

Re: Timing Shift Project Help

Something like this, perhaps ?

Code:

Option Explicit Private Function AddToShiftFile(daDate As Date, strData As String, Optional boClose As Boolean = False) As Integer ' ' Usage: Normal - intFile = AddToShiftFile(Now, Data to be written to the file) ' At Application Close - intFile = AddToShiftFile(Now, vbNullString, True) ' ' Outputs the data to the appropriate file depending on Time of Day ' Returns the File Number of the current file in use, or Zero when the file is closed ' Dim daTime As Date Dim daShifts(1, 1) As Date Dim strSFile As String Static intFile As Integer Static strCurSFile As String If Not boClose Then daShifts(0, 0) = TimeValue("06:30:00") daShifts(0, 1) = TimeValue("14:30:00") daShifts(1, 0) = TimeValue("14:30:00") daShifts(1, 1) = TimeValue("22:30:00") daTime = TimeValue(daDate) ' ' Select the appropriate output file ' depending upon which shift we're currently in ' Select Case True Case daTime > daShifts(0, 0) And daTime <= daShifts(0, 1) strSFile = "C:\MyApplication\Shift 06:30 - 14:30.txt" Case daTime > daShifts(1, 0) And daTime <= daShifts(1, 1) strSFile = "C:\MyApplication\Shift 14:30 - 22:30.txt" Case Else strSFile = "C:\MyApplication\Shift 22:30 - 06:30.txt" End Select ' ' If this shift is the same as the current shift ' then output the data to the file ' If strSFile = strCurSFile Then Print #intFile, strData Else ' ' Different shift, close the current file ' (if there was one open) ' Open up the new one, make it the current file ' and output the data ' If intFile > 0 Then Close #intFile intFile = FreeFile Open strSFile For Output As intFile strCurSFile = strSFile Print #intFile, strData End If AddToShiftFile = intFile Else Close #intFile AddToShiftFile = 0 End If End Function

Not tested but hopefully you can see the logic

EDIT: You may have to remember to adjust for the Canvey Island time-shift :D:D
Aug 18th, 2012, 09:51 AM
sbarber007

Re: Timing Shift Project Help

Hi Doogle
Thanks for your help couple of questions these few lines below that say strData should they be strRX and do i just copy what you wrote in to my vb6 code
thanks again

If strSFile = strCurSFile Then
Print #intFile, strData
Else
'
' Different shift, close the current file
' (if there was one open)
' Open up the new one, make it the current file
' and output the data
'
If intFile > 0 Then Close #intFile
intFile = FreeFile
Open strSFile For Output As intFile
strCurSFile = strSFile
Print #intFile, strData
Aug 18th, 2012, 10:11 AM
Doogle

Re: Timing Shift Project Help

Just copy and paste the Function Code into the Declarations Section of your Form and when you want to write the data just use:

Code:

intFile = AddToShiftFile(Now, strRX)

'strData' in the Function is local to the Function and nothing to do with 'strData' in the calling procedure.
Aug 20th, 2012, 02:18 PM
sbarber007

Re: Timing Shift Project Help

HI Doogle

Can you please check though my code please below I mark the bit below in red that no sure on thanks Doogle

'Way at top of code module of form.
Option Explicit

Private Function AddToShiftFile(daDate As Date, strData As String, Optional boClose As Boolean = False) As Integer
'
' Usage: Normal - intFile = AddToShiftFile(Now, Data to be written to the file)
' At Application Close - intFile = AddToShiftFile(Now, vbNullString, True)
'
' Outputs the data to the appropriate file depending on Time of Day
' Returns the File Number of the current file in use, or Zero when the file is closed
'
Dim daTime As Date
Dim daShifts(1, 1) As Date
Dim strSFile As String
Static intFile As Integer
Static strCurSFile As String
If Not boClose Then
daShifts(0, 0) = TimeValue("06:30:00")
daShifts(0, 1) = TimeValue("14:30:00")
daShifts(1, 0) = TimeValue("14:30:00")
daShifts(1, 1) = TimeValue("22:30:00")
daTime = TimeValue(daDate)
'
' Select the appropriate output file
' depending upon which shift we're currently in
'
Select Case True
Case daTime > daShifts(0, 0) And daTime <= daShifts(0, 1)
strSFile = "C:\MyApplication\Shift 06:30 - 14:30.txt"
Case daTime > daShifts(1, 0) And daTime <= daShifts(1, 1)
strSFile = "C:\MyApplication\Shift 14:30 - 22:30.txt"
Case Else
strSFile = "C:\MyApplication\Shift 22:30 - 06:30.txt"
End Select
'
' If this shift is the same as the current shift
' then output the data to the file
'
If strSFile = strCurSFile Then
Print #intFile, strData
Else
'
' Different shift, close the current file
' (if there was one open)
' Open up the new one, make it the current file
' and output the data
'
If intFile > 0 Then Close #intFile
intFile = FreeFile
Open strSFile For Output As intFile
strCurSFile = strSFile
Print #intFile, strData
End If
AddToShiftFile = intFile
Else
Close #intFile
AddToShiftFile = 0
End If
End Function

Private Sub Command1_Click()
MSComm1.PortOpen = False
End
End Sub

Private Sub Command2_Click()
SearchFrm.Show
'Shell ("FSUTIL VOLUME DISMOUNT E:")
'Shell ("c:\dismount.bat")
End Sub

Private Sub Command4_Click()
FrmPass.Show
End Sub

Private Sub Command8_Click()
ViewRejects.Show
End Sub

Private Sub Form_Load()
Dim textfile As String

Open "C:\users\administrator\dirnames.txt" For Input As #1
Do While Not EOF(1)
Input #1, textfile
FolderCreator.Combo1.AddItem (textfile)
Loop
Close #1

' Show Date on main screen.
'Label3.Caption = DateValue(Now)

' Fire Rx Event Every Two Bytes
MSComm1.RThreshold = 1

' When Inputting Data, Input 2 Bytes at a time
MSComm1.InputLen = 13

' 9600 Baud, No Parity, 8 Data Bits, 1 Stop Bit
MSComm1.Settings = "9600,N,8,1"
' Disable DTR
MSComm1.DTREnable = False

' Open COM1
MSComm1.CommPort = 1
MSComm1.PortOpen = True
MSComm1.InBufferCount = 0
End Sub

Private Sub MSComm1_OnComm()

'
' Assumes RTHreshold Property is set to a value > 0
' (Recommended value is 1)
'
Static strBuffer As String
Dim strData As String
Dim strRX As String
Dim boComplete As Boolean
Select Case MSComm1.CommEvent
Case comEvReceive
strData = MSComm1.Input
strBuffer = strBuffer & strData
Do
If Len(strBuffer) >= 13 Then
strRX = Mid$(strBuffer, 1, 13)
'
' rest of your code goes here - strRX contains the 13 characters sent
' After you've done all your processing add the following code
'
Label8.Caption = strRX
'MSComm1.Output = strRX
Dim wshThisShell As WshShell
Dim lngRet As Long
Dim strShellCommand As String
Dim strBatchPath As String
'label8.caption = ""
Set wshThisShell = New WshShell
strBatchPath = "c:\deletevert.bat"
'the path for the batch file you're using
strShellCommand = Chr$(34) & strBatchPath & Chr$(34)
'the ridiculous number of quotation marks is necessary
'when there is a space in one or more of the folder names
lngRet = wshThisShell.Run(strShellCommand, vbNormalFocus, vbTrue)
'set 3rd argument above to vbFalse for asynchronous
'execution of the batch file.
'label8.caption = ""
'label9.caption = ""
If Dir$("e:\" & strRX, vbDirectory) = "" Then

Label9.Caption = "Directory does not exist."
MkDir "e:\" & strRX
MkDir "e:\" & strRX & "\" & FolderCreator.Combo1.List(0)
MkDir "e:\" & strRX & "\" & FolderCreator.Combo1.List(1)
MkDir "e:\" & strRX & "\" & FolderCreator.Combo1.List(2)
MkDir "e:\" & strRX & "\" & FolderCreator.Combo1.List(3)
MkDir "e:\" & strRX & "\" & FolderCreator.Combo1.List(4)
MkDir "e:\" & strRX & "\" & FolderCreator.Combo1.List(5)
MkDir "e:\" & strRX & "\" & FolderCreator.Combo1.List(6)
MkDir "e:\" & strRX & "\" & FolderCreator.Combo1.List(7)
MkDir "e:\" & strRX & "\" & FolderCreator.Combo1.List(8)
MkDir "e:\" & strRX & "\" & FolderCreator.Combo1.List(9)
MkDir "e:\" & strRX & "\" & FolderCreator.Combo1.List(10)
MkDir "e:\" & strRX & "\" & FolderCreator.Combo1.List(11)
MkDir "e:\" & strRX & "\" & FolderCreator.Combo1.List(12)
MkDir "e:\" & strRX & "\" & FolderCreator.Combo1.List(13)
MkDir "e:\" & strRX & "\" & FolderCreator.Combo1.List(14)
MkDir "e:\" & strRX & "\" & FolderCreator.Combo1.List(15)

Shell ("net use Z: " & "\\ENDOFLINE\STORAGE\" & strRX & " /persistent:yes")
Shell ("net use Z: " & "\\ENDOFLINE\STORAGE\" & strRX & " /persistent:yes")
MSComm1.Output = strRX

Else

ViewRejects.ViewList.AddItem strRX & " REJECTED ON " & Now
Label5.Caption = ViewRejects.ViewList.ListCount
Label9.Caption = "Directory exists."
Shell ("net use Z: " & "\\ENDOFLINE\STORAGE\" & strRX & " /persistent:yes")
Shell ("net use Z: " & "\\ENDOFLINE\STORAGE\" & strRX & " /persistent:yes")
MSComm1.Output = strRX

intFile = AddToShiftFile(Now, strRX) I get a compile error Variable not defined at this point
am I right in thinking this is the right place for this to trigger your shift function code

'Way at top of code module of form.

Open "e:\REJECTS.txt" For Append As #1
' For I = 0 To Lis't1.ListCount - 1
Print #1, strRX & " REJECTED ON " & Now
' Next
Close #1

Open "e:\" & strRX & "\REJECTS.txt" For Append As #2
' For I = 0 To Lis't1.ListCount - 1
Print #2, strRX & " REJECTED ON " & Now
' Next
Close #2
End If

If Len(strBuffer) = 13 Then
strBuffer = ""
boComplete = True
Else
strBuffer = Mid$(strBuffer, 14)
End If
Else
boComplete = True
End If
Loop Until boComplete = True
End Select
End Sub

Private Sub Form_Unload(Cancel As Integer)
'MSComm1.PortOpen = False
Cancel = 1

End Sub

Regards

Steve
Aug 20th, 2012, 03:21 PM
Doogle

Re: Timing Shift Project Help

You need to define 'intFile'

Code:

Private Sub MSComm1_OnComm() ' ' Assumes RTHreshold Property is set to a value > 0 ' (Recommended value is 1) ' Dim intFile As Integer
Aug 23rd, 2012, 05:37 AM
sbarber007

Re: Timing Shift Project Help

@DOOGLE

Sorry to be a pain in the *** i need guidance to change your code slightly instead of having the file open all the time I just want to save to a CSV file at 06:30, 14:30, 22:30 put diffent shift times into the same CSV file at these times mark in red needs to be verbal of shift times. Exsample of contents of CSV file

Date SHIFT TIME TOTAL OK TOTAL NOK
23/08/2012 14:30-22:30 345 50
23/08/2012 22:30-06:30 500 34
23/08/2012 06:30-14:30 234 67
and so on

Open "F:\COUNTS.CSV" For Append As #1
' For I = 0 To Lis't1.ListCount - 1
Print #1, Now & ",06:30-14:30," & Label4.Caption & "," & Label5.Caption & "," & TextBox1.Text & "," & TextBox2.Text & "," & TextBox3.Text & "," & TextBox4.Text & "," & TextBox5.Text & "," & TextBox6.Text & "," & TextBox7.Text & "," & TextBox8.Text & "," & TextBox9.Text & "," & TextBox10.Text & "," & TextBox11.Text & "," & TextBox12.Text & "," & TextBox13.Text & "," & TextBox14.Text & "," & TextBox15.Text & "," & TextBox16.Text

' Next
Close #1
regards
steve
Aug 25th, 2012, 03:48 AM
Doogle

Re: Timing Shift Project Help

That's a fairly major shift (excuse the pun) in requirements. I assume that somewhere in your code you're summarising the data by shift time. That being the case you'll have to have a Timer, triggering for example every 30 seconds and in the Timer event, check the Time of Day against shift ends. The problem is that Timers are not very accurate so you'd need to check the Hour and Minute and then 'remember' when you've written the data and, say, a minute later 'forget' (so you don't rewrite it when the Timer triggers again in the same minute).

I've come up with, what I think is a complicated solution, but may be something you can play with. Others may have a clearer head than mine and can simplify it.

Code:

Option Explicit Private Sub Timer1_Timer() Dim daNow As Date Dim intShift As Integer Static boWritten(2) As Boolean daNow = TimeValue(Now) Select Case True ' ' Check whether the hour and Minute match an end of shift ' If so then set intShift appropriately ' Case Format(daNow, "hh") = "14" And Format(daNow, "mm") = "30" intShift = 0 Case Format(daNow, "hh") = "22" And Format(daNow, "mm") = "30" intShift = 1 Case Format(daNow, "hh") = "06" And Format(daNow, "mm") = "30" intShift = 2 End Select ' ' Have we recently written data for this shift? ' If not then write it ' If Not boWritten(intShift) Then Call WriteCSV(intShift) boWritten(intShift) = True Else ' ' Is the minute one more than shift end? ' if so then we can clear the 'written' flag ' for that shift ' Select Case True Case Format(daNow, "hh") = "14" And Format(daNow, "mm") = "31" boWritten(0) = False Case Format(daNow, "hh") = "22" And Format(daNow, "mm") = "31" boWritten(1) = False Case Format(daNow, "hh") = "06" And Format(daNow, "mm") = "31" boWritten(2) = False End Select End If End Sub Private Sub WriteCSV(intShift As Integer) Dim intFile As Integer Dim strShift As String intFile = FreeFile Select Case intShift Case 0 strShift = "06:30 - 14:30" Case 1 strShift = "14:30 - 22:30" Case 2 strShift = "22:30 - 06:30" End Select Open "c:\MyApp\ShiftData.csv" For Append As intFile Print #intFile, Format(Now, "dd/mm/yyyy");","; strShift;","; whatever_other_data_is_required Close intFile End Sub

EDIT: You may have to play around with the Timer's Interval value to ensure you get at least 1 event for every minute and to minimise the possibility of getting the odd bit of data going into the wrong shift. (eg if the timer triggers for the first time in the 30th minute, at 06:30:30 you'll record the last 30 seconds worth of data into the 22:30 - 06:30 shift) I don't think I know of a method to trigger an event at an exact time of day with VB6.
Aug 25th, 2012, 04:45 AM
Doogle

Re: Timing Shift Project Help

This whole thing would be made a lot easier if the data being collected from the machines was time stamped - I don't suppose that's a possibility is it ?
Aug 25th, 2012, 01:15 PM
sbarber007

Re: Timing Shift Project Help

HI Doogle

Thanks for the reply and your help the only data I get from the machine is the engine serial number example of a serial number is 1708122222345 the first is 6 of number is the date but this does not always come around in sequence but no time, would it only be 1min and no more out sequence because this might not be problem if 1 engine goes in next shift I might get away with that.

But in my code has you can see below I already have a timer1 that I need to run every time after its created the folders or if there already exist but in the my timer1 code is where it creates the CSV file but I want it to only write the CSV has you know at 06:30,14:30,22:30 but ignore writing any other times when timer1 runs. I am Thinking maybe wrong place to have CSV file creating bit in the timer1 bit but It needs to be done after my timer1 is finished and at that time check if its time to write the CSV or not.

'Way at top of code module of form.
Option Explicit

Private Sub Timer1_Timer()
Dim daNow As Date
Dim intShift As Integer
Static boWritten(2) As Boolean
daNow = TimeValue(Now)
Select Case True
'
' Check whether the hour and Minute match an end of shift
' If so then set intShift appropriately
'
Case Format(daNow, "hh") = "14" And Format(daNow, "mm") = "30"
intShift = 0
Case Format(daNow, "hh") = "22" And Format(daNow, "mm") = "30"
intShift = 1
Case Format(daNow, "hh") = "06" And Format(daNow, "mm") = "30"
intShift = 2
End Select
'
' Have we recently written data for this shift?
' If not then write it
'
If Not boWritten(intShift) Then
Call WriteCSV(intShift)
boWritten(intShift) = True
Else
'
' Is the minute one more than shift end?
' if so then we can clear the 'written' flag
' for that shift
'
Select Case True
Case Format(daNow, "hh") = "14" And Format(daNow, "mm") = "31"
boWritten(0) = False
Case Format(daNow, "hh") = "22" And Format(daNow, "mm") = "31"
boWritten(1) = False
Case Format(daNow, "hh") = "06" And Format(daNow, "mm") = "31"
boWritten(2) = False
End Select
End If
End Sub

Private Sub WriteCSV(intShift As Integer)
Dim intFile As Integer
Dim strShift As String
intFile = FreeFile
Select Case intShift
Case 0
strShift = "06:30 - 14:30"
Case 1
strShift = "14:30 - 22:30"
Case 2
strShift = "22:30 - 06:30"
End Select
Open "c:\MyApp\ShiftData.csv" For Append As intFile
Print #intFile, Format(Now, "dd/mm/yyyy"); ","; strShift; ","; whatever_other_data_is_required
Close intFile
End Sub

Private Sub Command1_Click()
MSComm1.PortOpen = False
End
End Sub

Private Sub Command2_Click()
SearchFrm.Show
'Shell ("FSUTIL VOLUME DISMOUNT E:")
'Shell ("c:\dismount.bat")
End Sub

Private Sub Command3_Click()
Timer1.Enabled = True
End Sub

Private Sub Command4_Click()
FrmPass.Show
End Sub

Private Sub Command8_Click()
ViewRejects.Show
End Sub

Private Sub Form_Load()
Dim textfile As String

Open "C:\users\administrator\dirnames.txt" For Input As #1
Do While Not EOF(1)
Input #1, textfile
FolderCreator.Combo1.AddItem (textfile)
Loop
Close #1

' Show Date on main screen.
'Label3.Caption = DateValue(Now)

' Fire Rx Event Every Two Bytes
MSComm1.RThreshold = 1

' When Inputting Data, Input 2 Bytes at a time
MSComm1.InputLen = 13

' 9600 Baud, No Parity, 8 Data Bits, 1 Stop Bit
MSComm1.Settings = "9600,N,8,1"
' Disable DTR
MSComm1.DTREnable = False

' Open COM1
'MSComm1.CommPort = 1
'MSComm1.PortOpen = True
MSComm1.InBufferCount = 0
End Sub

Private Sub MSComm1_OnComm()

'
' Assumes RTHreshold Property is set to a value > 0
' (Recommended value is 1)
'
Static strBuffer As String
Dim strData As String
Dim strRX As String
Dim boComplete As Boolean
Select Case MSComm1.CommEvent
Case comEvReceive
strData = MSComm1.Input
strBuffer = strBuffer & strData
Do
If Len(strBuffer) >= 13 Then
strRX = Mid$(strBuffer, 1, 13)
'
' rest of your code goes here - strRX contains the 13 characters sent
' After you've done all your processing add the following code
'
Label8.Caption = strRX
'MSComm1.Output = strRX
Dim wshThisShell As WshShell
Dim lngRet As Long
Dim strShellCommand As String
Dim strBatchPath As String
'label8.caption = ""
Set wshThisShell = New WshShell
strBatchPath = "c:\deletevert.bat"
'the path for the batch file you're using
strShellCommand = Chr$(34) & strBatchPath & Chr$(34)
'the ridiculous number of quotation marks is necessary
'when there is a space in one or more of the folder names
lngRet = wshThisShell.Run(strShellCommand, vbNormalFocus, vbTrue)
'set 3rd argument above to vbFalse for asynchronous
'execution of the batch file.
'label8.caption = ""
'label9.caption = ""
If Dir$("e:\" & strRX, vbDirectory) = "" Then

Label9.Caption = "Directory does not exist."
MkDir "e:\" & strRX
MkDir "e:\" & strRX & "\" & FolderCreator.Combo1.List(0)
MkDir "e:\" & strRX & "\" & FolderCreator.Combo1.List(1)
MkDir "e:\" & strRX & "\" & FolderCreator.Combo1.List(2)
MkDir "e:\" & strRX & "\" & FolderCreator.Combo1.List(3)
MkDir "e:\" & strRX & "\" & FolderCreator.Combo1.List(4)
MkDir "e:\" & strRX & "\" & FolderCreator.Combo1.List(5)
MkDir "e:\" & strRX & "\" & FolderCreator.Combo1.List(6)
MkDir "e:\" & strRX & "\" & FolderCreator.Combo1.List(7)
MkDir "e:\" & strRX & "\" & FolderCreator.Combo1.List(8)
MkDir "e:\" & strRX & "\" & FolderCreator.Combo1.List(9)
MkDir "e:\" & strRX & "\" & FolderCreator.Combo1.List(10)
MkDir "e:\" & strRX & "\" & FolderCreator.Combo1.List(11)
MkDir "e:\" & strRX & "\" & FolderCreator.Combo1.List(12)
MkDir "e:\" & strRX & "\" & FolderCreator.Combo1.List(13)
MkDir "e:\" & strRX & "\" & FolderCreator.Combo1.List(14)
MkDir "e:\" & strRX & "\" & FolderCreator.Combo1.List(15)

Shell ("net use Z: " & "\\ENDOFLINE\STORAGE\" & strRX & " /persistent:yes")
Shell ("net use Z: " & "\\ENDOFLINE\STORAGE\" & strRX & " /persistent:yes")
MSComm1.Output = strRX

Else

ViewRejects.ViewList.AddItem strRX & " REJECTED ON " & Now
Label5.Caption = ViewRejects.ViewList.ListCount
Label9.Caption = "Directory exists."
Shell ("net use Z: " & "\\ENDOFLINE\STORAGE\" & strRX & " /persistent:yes")
Shell ("net use Z: " & "\\ENDOFLINE\STORAGE\" & strRX & " /persistent:yes")
MSComm1.Output = strRX

End If
Timer1.Enabled = True

''Open "e:\REJECTS.txt" For Append As #1
' For I = 0 To Lis't1.ListCount - 1
' Print #1, strRX & " REJECTED ON " & Now
' Next
'Close #1

'Open "e:\" & strRX & "\REJECTS.txt" For Append As #2
' For I = 0 To Lis't1.ListCount - 1
' Print #2, strRX & " REJECTED ON " & Now
' Next
'Close #2

If Len(strBuffer) = 13 Then
strBuffer = ""
boComplete = True
Else
strBuffer = Mid$(strBuffer, 14)
End If
Else
boComplete = True
End If
Loop Until boComplete = True
End Select
End Sub

Private Sub Form_Unload(Cancel As Integer)
'MSComm1.PortOpen = False
Cancel = 1

End Sub

Private Sub Timer1_Timer()
Dim i As Integer
Dim txt As TextBox
Dim strPath As String
Dim strFile As String
Dim lngCount As Long

For i = 1 To 16
strPath = "f:\" & Format(i, "000") & "\*reject*.bmp"
Set txt = Controls("TextBox" & i)

strFile = Dir(strPath)

lngCount = 0

Do Until strFile = ""
lngCount = lngCount + 1
strFile = Dir
Loop

txt.Text = lngCount
Next i

Open "F:\COUNTS.CSV" For Append As #1
' For I = 0 To Lis't1.ListCount - 1
Print #intFile, Format(Now, "dd/mm/yyyy");","; strShift;"," & Label4.Caption & "," & Label5.Caption & "," & TextBox1.Text & "," & TextBox2.Text & "," & TextBox3.Text & "," & TextBox4.Text & "," & TextBox5.Text & "," & TextBox6.Text & "," & TextBox7.Text & "," & TextBox8.Text & "," & TextBox9.Text & "," & TextBox10.Text & "," & TextBox11.Text & "," & TextBox12.Text & "," & TextBox13.Text & "," & TextBox14.Text & "," & TextBox15.Text & "," & TextBox16.Text

' Next
Close #1

Dim line1 As String, line2 As String, line3 As String, line4 As String
If Dir("F:\TEST.txt") <> "" Then

Open "F:\TEST.txt" For Input As #1
Line Input #1, line1
Line Input #1, line2
Line Input #1, line3
Line Input #1, line4
Close #1

ViewRejects.ViewList.AddItem " REJECTED ON " & line4

Open "F:\REJECT.txt" For Append As #2
' For I = 0 To Lis't1.ListCount - 1
Print #2, " 06:30-14:30 " & line4
' Next
Close #2
Else

End If

Timer1.Enabled = False
End Sub

regards
steve

regards
Steve
Aug 25th, 2012, 03:34 PM
Doogle

Re: Timing Shift Project Help

Perhaps we need to review exactly what you're trying to do. I've had a look at your code and can't see what you're trying to achieve. Perhaps you could describe; I really don't understand all the MkDirs which depend upon the data received from the MSComm. Could you perhaps describe in logical terms what happens when and what to do when it happens?
Aug 26th, 2012, 04:52 AM
sbarber007

Re: Timing Shift Project Help

Hi Doogle

I try and explain basically is a vision system that check car engines being built correctly this system is check the engine at the end of the line making sure all the components are there we have a software on the system called neurocheck that captures all the images from digital cameras and stores all the images on 3tb hard drive the problem with neurocheck software is we can only set one path for saving images for each check running there're are 10 different checks the software does. what the vb code does when the engine comes in to station with the cameras it receives the engine serial number via comms port then creates a folder with the engine serial number and also creates the sub folders within it 001,002,003 etc. for each 10 checks then the code this is saved on the E: drive then the code creates a vertial drive (z: drive) so when you open up z: drive you have the sub folders 001,002,003,004 etc. from the engine serial number that's active so its easier for the other software to save images to It takes about 12secs to run the 10 checks, so I want to start the timer1 code 15sec later because it should of finish do the 10 checks and also in the timer1 code it searches for recject files and counts how many there are in each 001 002 003 etc etc folders and put the results in the textbox that I want to output to CSV FILE long with what shift build the engine. I need to output the results to the CSV file at those times. when it searches the reject files I need to check the z drive and count how many rejects files there are add to the textboxs but when the next engine comes in count how many rejects and add it to the last figure need to sort that out just thought of that but clear those figures after the CSV file been created.

I think that covers it. thank you for taken your time in this . if it help I email you the code so you can see it.
regards steve