Check for a Excel file name, if not exist save as todays date???
Posted by Chris on November 19, 2001 4:48 AM
I am try to do some basic file handling that I am not sure about. I would like to open a file or template (XLS) file then look in a specific directory if a file exist.
if the file name DOES NOT exist, then save the template file as the today's date ON OPEN of the spreadsheet
example: m1138-11-19-2001.xls
would be the current workbook name while the sheet is running a logging for that day.
if the file name DOES exist, then save the template file as todays date with the -1, or -2 etc.
example: m1138-11-19-2001-1.xls
the reason for this, is if the sheet is CLOSED for the day, then reopened the SAME DAY, I would like for it to start over the log sheet using a different name hence the -1,-2,-3. HECK, I wouldn't be opposed if something could be written to REOPEN the SAME sheet of the SAME DAY and append to the current log then if the DATE is different, then SAVE AS the DATE name...I hope that is not to confusing...
Here is what I got so far: it's not even close to what I need, but maybe will help you see what I am needing:
'VB Script written for DDE from SLC500 to EXCEL Sheet
'Revision 1.0 11-16-2001 by Chris Elston
'My first "real" VB coding/script so give me a break ok?
'QSI Automation, Inc. 219-693-1500
'This sheet LOGS 7 words from the "F:10" address of the PLC
'It also checks for the HOTLINK DDE to be active if not ERROR out
'Store the EXCEL files by DAYS in the C:\qsi folder
'Opens template XLS file from template directory, saves as date in -1 -2 -3 etc format
'if same day.
Sub auto_open()
Dim strFileName As String
strFileName = "M1138ce"
'start a macro
Application.Run Macro:="M1138.xls!Auto"
'turn of user prompts
Application.DisplayAlerts = False
'save template as a new name
ActiveWorkbook.SaveAs FileName:="C:\qsi\" & strFileName & ".xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False
'turn user prompts back on
Application.DisplayAlerts = True
End Sub
Sub Auto()
' A bit change from the PLC Hot Linked on INDATA
' will automaticly Run Macro (start).
Worksheets("INDATA").OnData = "Start"
End Sub
Sub Start()
Dim lngRow As Long
Dim bytCycle As Byte
Dim bytLogging As Byte
On Error GoTo Error
'assign btye to varible
bytLogging = Range("[M1138.xls]INDATA!A10").Value
'opens DDE link
''RSIchan = DDEInitiate("RSLinx", "M1138")
bytCycle = 1
'check cycle bit
''bytCYCLE = DDERequest(RSIchan, "B10:0/1")
'close DDE link
''DDETerminate (RSIchan)
'check to see if the Cycle bit went to "1" if it did, excute read data
If bytCycle And bytLogging = "1" Then
'looks for sheet M1138
Windows("M1138.XLS").Activate
'starts at row 3 of sheet
lngRow = 3
If Range("[M1138.xls]INDATA!A3").Value > 3 Then
'look up last cell and change position
lngRow = Range("[M1138.xls]INDATA!A3").Value
End If
'check until end of sheet
For lngRow = lngRow To 65500
'look for next empty cell
If Cells(lngRow, 1) = "" Then Exit For
'write current cell location to sheet INDATA
'rather than writing a loop to search on
'every cycle, by the time the log is at row 21,500
'it could take a long time to search the rows...
Range("[M1138.xls]INDATA!A3").Value = lngRow + 1
'add 1 to row "x" to check next row
Next
'opens a COLD DDE link
''RSIchan = DDEInitiate("RSLinx", "M1138")
'there might be a better way to do this like
'using this somehow ???????? but I don't know how
'data = DDERequest(RSIchan, "f11:0,L7,C7")
'Range("[M1138.xls]LOG!R[x]C1:R[x]C7").Value = data
'looks for sheet M1138
Windows("M1138.XLS").Activate
'Make Sure Log sheet is Active
Sheets("LOG").Select
'read word 0
data = DDERequest(RSIchan, "F11:0")
Cells(x, 1).Value = data
'read word 1
data = DDERequest(RSIchan, "F11:1")
Cells(x, 2).Value = data
'read word 2
data = DDERequest(RSIchan, "F11:2")
Cells(x, 3).Value = data
'read word 3
data = DDERequest(RSIchan, "F11:3")
Cells(x, 4).Value = data
'read word 4
data = DDERequest(RSIchan, "F11:4")
Cells(x, 5).Value = data
'read word 5
data = DDERequest(RSIchan, "F11:5")
Cells(x, 6).Value = data
'read word 6
data = DDERequest(RSIchan, "F11:6")
Cells(x, 7).Value = data
'capture time and date stamp into column 8
Cells(x, 8).Value = Now()
'close COLD DDE link
DDETerminate (RSIchan)
End If
Error:
MsgBox ("Communications have been lost! Can not log data anymore. Check PLC connection and wiring")
End Sub
Sub auto_close()
Dim strFileName As String
strFileName = "M1138ce"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs FileName:="C:\qsi\" & strFileName & ".xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False
Application.DisplayAlerts = True
End Sub