Continue to Site

Eng-Tips is the largest engineering community on the Internet

Intelligent Work Forums for Engineering Professionals

  • Congratulations IDS on being selected by the Eng-Tips community for having the most helpful posts in the forums last week. Way to Go!

VB code to run Excel dde

Status
Not open for further replies.

rsmpls

Automotive
Nov 9, 2002
3
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.
 
Replies continue below

Recommended for you

Sounds like you are looking for a sheet for each shift. If this is true that’s a lot of sheet. I would like to recommend using database programs instead of excel. Have you investigated this as an option? It seams to be easier and all your excel sheets would import. And the data would be much more manageable.
 
I did one that automatically closed the sheet and saved it as that day's date, then opened another sheet at MIDNIGHT.

Download the whole thing here:


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 <> &quot;M1138.xls&quot; 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) = &quot;-&quot; 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) = &quot;-&quot; 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) = &quot;-&quot; Then
strCharYear = Mid$(strCurrentOpenedWorkBook, intLoop3 + 1, 4)
Exit For
End If
Next

If strCharMonth2 = &quot;-&quot; Then
lngFileDateMonth = strCharMonth1
Else
lngFileDateMonth = (strCharMonth1 * 10) + strCharMonth2
End If

If strCharDay2 = &quot;-&quot; 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(&quot;3:65500&quot;).Select

'clear all data
Selection.ClearContents

'select a cell to get ready
Range(&quot;A3&quot;).Select

Range(&quot;INDATA!A3&quot;).Value = 3

'save a new day under new file name
ActiveWorkbook.SaveAs Filename:=&quot;C:\qsi\&quot; & strFileName, FileFormat:= _
xlNormal, Password:=&quot;&quot;, WriteResPassword:=&quot;&quot;, ReadOnlyRecommended:=False
Application.Run Macro:=&quot;Auto&quot;
Else
GoTo DateOk
End If

End If
DateOk:
End Sub

Chris Elston
Automation & Controls Engineer
Download Sample PLC Ladder Logic Code
at MrPLC.com
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor