VB code to run Excel dde
VB code to run Excel dde
(OP)
I have an Excel spreadsheet setup to record a machines downtime, faults,,,etc. What I would like to do now is have that Excel dde app. start and close automatically at the end of each shift. Is there anyone with a similar VB6 app that would be willing to share? I am an old PLC controls guy that is a newbie to VB. Any comments will be appreciated.





RE: VB code to run Excel dde
RE: VB code to run Excel dde
Download the whole thing here:
http://www.mrplc.com/dl/index.php?action=view&view=entry&entryid=74
Here is the CODE:
Sub ChkTime()
Dim strFileName As String
Dim strNowDate As String
Dim lngMonth As Long
Dim lngDay As Long
Dim lngYear As Long
Dim strCharMonth1 As String
Dim strCharMonth2 As String
Dim strCharDay1 As String
Dim strCharDay2 As String
Dim strCharYear As String
Dim lngFileDateMonth As Long
Dim lngFileDateDay As Long
Dim lngFileDateYear As Long
Dim intCountMonth As Integer
Dim intCountDay As Integer
Dim intLoop1 As Integer
Dim intLoop2 As Integer
Dim intLoop3 As Integer
Dim strCurrentOpenedWorkBook As String
strCurrentOpenedWorkBook = ActiveWorkbook.Name
'extracts today's date as serial number
strNowDate = Now()
'converts serial number back to months
lngMonth = Month(strNowDate)
'converts serial number back to days
lngDay = Day(strNowDate)
'converts serial number back to years
lngYear = Year(strNowDate)
'assign a file name from date
strFileName = "M1138-" & lngMonth & "-" & lngDay & "-" & lngYear
'don't check time if the file is not named by date format
If strCurrentOpenedWorkBook <> "M1138.xls" Then
'parse the existing file to current date (HEY What can I say! I liked my PARSER code!)
For intLoop1 = 1 To Len(strCurrentOpenedWorkBook)
If Mid$(strCurrentOpenedWorkBook, intLoop1, 1) = "-" Then
strCharMonth1 = Mid$(strCurrentOpenedWorkBook, intLoop1 + 1, 1)
strCharMonth2 = Mid$(strCurrentOpenedWorkBook, intLoop1 + 2, 1)
intLoop1 = intLoop1 + 1
Exit For
End If
Next
For intLoop2 = intLoop1 To Len(strCurrentOpenedWorkBook)
If Mid$(strCurrentOpenedWorkBook, intLoop2, 1) = "-" Then
strCharDay1 = Mid$(strCurrentOpenedWorkBook, intLoop2 + 1, 1)
strCharDay2 = Mid$(strCurrentOpenedWorkBook, intLoop2 + 2, 1)
intLoop2 = intLoop2 + 1
Exit For
End If
Next
For intLoop3 = intLoop2 To Len(strCurrentOpenedWorkBook)
If Mid$(strCurrentOpenedWorkBook, intLoop3, 1) = "-" Then
strCharYear = Mid$(strCurrentOpenedWorkBook, intLoop3 + 1, 4)
Exit For
End If
Next
If strCharMonth2 = "-" Then
lngFileDateMonth = strCharMonth1
Else
lngFileDateMonth = (strCharMonth1 * 10) + strCharMonth2
End If
If strCharDay2 = "-" Then
lngFileDateDay = strCharDay1
Else
lngFileDateDay = (strCharDay1 * 10) + strCharDay2
End If
lngFileDateYear = strCharYear
'compare existing file to today's date
If lngFileDateYear < lngYear Or lngFileDateMonth < lngMonth Or _
lngFileDateDay < lngDay Then
'save file before close
ActiveWorkbook.Save
'select all data rows
Rows("3:65500").Select
'clear all data
Selection.ClearContents
'select a cell to get ready
Range("A3").Select
Range("INDATA!A3").Value = 3
'save a new day under new file name
ActiveWorkbook.SaveAs Filename:="C:\qsi\" & strFileName, FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False
Application.Run Macro:="Auto"
Else
GoTo DateOk
End If
End If
DateOk:
End Sub
Chris Elston
Automation & Controls Engineer
http://www.mrplc.com
Download Sample PLC Ladder Logic Code
at MrPLC.com