Scheduling Conflict: can only detect conflict with exact time - visual-studio

This is the last problem I have to face in for my capstone project, and it's driving me nuts.
Basically, I have to be able to identify if Section/Faculty/Room are all in use when scheduling a subject, to avoid conflicts.
Here's what I've worked on, but so far it can only detect when Room is in use.
I can't figure out how to be able to prevent scheduling that's in-between time periods. For example: First entry would be 7-8:30AM. Second entry would be 7:30 AM to 9 AM. With the former existing, it should reject the latter but I can't figure out how to do that. This is what I've cooked up so far. How would you guys go about this?
Public Function DataInUse() As Boolean
Dim Temp As Boolean
Temp = False
If FacultyInUse() = True Then
MessageBox.Show("Faculty in use.")
cboFaculty.Focus()
DisplayFacultyInUse()
DisplayLabelConflictForFaculty()
Temp = True
ElseIf RoomInUse() = True Then
MessageBox.Show("Room in use.")
cboRoom.Focus()
DisplayRoomInUse()
DisplayLabelConflictForRoom()
Temp = True
End If
Return Temp
End Function
Public Function FacultyInUse() As Boolean
Dim com As New OleDbCommand(" Select * from qrySubjectOfferring Where cTimeIn >=#" & cboFrom.Text & "# and cTimeOut <=#" & cboTo.Text & "# and Faculty like'" & cboFaculty.Text & "%' and cDay Like '%" & cboDay.Text & "%'", clsCon.con)
Dim dr As OleDbDataReader = com.ExecuteReader()
dr.Read()
If dr.HasRows Then
Return True
Else
Return False
End If
End Function
Public Function RoomInUse() As Boolean
Dim com As New OleDbCommand("Select * from qryRoomAvailability WHERE (cTimeIn <=#" & cboFrom.Text & "# AND cTimeOut >=#" & cboFrom.Text & "# AND Room = '" & cboRoom.Text & "' AND cDay = '" & cboDay.Text & "') OR (cTimeIn <=#" & cboTo.Text & "# AND cTimeOut >=#" & cboTo.Text & "# AND Room = '" & cboRoom.Text & "' AND cDay = '" & cboDay.Text & "') OR (cTimeIn >= #" & cboFrom.Text & "# AND cTimeOut <= #" & cboTo.Text & "# AND Room = '" & cboRoom.Text & "' AND cDay = '" & cboDay.Text & "') ", clsCon.con)
Dim dr As OleDbDataReader = com.ExecuteReader()
dr.Read()
If dr.HasRows Then
Return True
Else
Return False
End If
End Function
Public Function SubjectAlreadyOffered(sSubject As String) As Boolean
Dim com As New OleDbCommand("Select * from qrySubjectOfferring Where Subject LIKE '%" & sSubject & "%'", clsCon.con)
Dim dr As OleDbDataReader = com.ExecuteReader()
dr.Read()
If dr.HasRows Then
Return True
Else
Return False
End If
End Function

Try simplifying your SQL to use Between clause and eliminate all entries where the From or To are in existing entries
In your RoomInUse() function
Dim strSQL as String
strSQL = "SELECT * FROM qryRoomAvailability WHERE " & _
" Room = '" & cboRoom.Text & "' AND cDay = '" & cboDay.Text & "'" & _
" AND NOT (#" & cboFrom.Text "# BETWEEN [" & cTimeIn & "] AND [" & cTimeOut & "])" & _
" AND NOT (#" & cboTo.Text "# BETWEEN [" & cTimeIn & "] AND [" & cTimeOut & "])"
Dim com As New OleDbCommand(strSQL, clsCon.con)

Related

WQL-Statement to check an application's event log

I would like to analyze the event log of a special windows application (Windows 7 Enterprise, 64Bit).
I need a special event which is logged some seconds ago.
Here is my VBScript code, which produces a completely wrong result (wrong number of events):
strComputer = "." ' Dieser Computer
' Retrieving Specific Events from an Event Log
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\" & strComputer & "\root\cimv2")
Const CONVERT_TO_LOCAL_TIME = True
Set dtmStartDate = CreateObject("WbemScripting.SWbemDateTime")
Set dtmEndDate = CreateObject("WbemScripting.SWbemDateTime")
dtmStartDate.SetVarDate dateadd("s", -10, now()) ' CONVERT_TO_LOCAL_TIME
dtmEndDate.SetVarDate now() ' CONVERT_TO_LOCAL_TIME
dim var_wql
var_wql = "SELECT * FROM Win32_NTLogEvent WHERE Logfile = '< ... >' AND SourceName = '< ... >' AND EventCode = '< ... >' AND (TimeWritten >= '" & dtmStartDate & "') AND (TimeWritten < '" & dtmEndDate & "')"
Set colLoggedEvents = objWMIService.ExecQuery(var_wql)
...
The number of rows (anzahl = colLoggedEvents.count) must be 0 or 1, anything else is impossible.
What is wrong with the wql statement? I would like to check the last seconds in the past (from now).
Thanks.
Tommy
Syntax error. If I change the objWMIService line to this, it works for me.
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate,authenticationLevel=pktPrivacy}!\\" & strComputer & "\root\cimv2")
Updated to grab ALL event logs created in the last 10 secs and write to log file.
On Error Resume Next
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate,authenticationLevel=pktPrivacy}!\\.\root\cimv2")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set WshShell = WScript.CreateObject("WScript.Shell")
strSystemDrive = WshShell.ExpandEnvironmentStrings("%SystemDrive%")
Const CONVERT_TO_LOCAL_TIME = True
Set dtmStartDate = CreateObject("WbemScripting.SWbemDateTime")
Set dtmEndDate = CreateObject("WbemScripting.SWbemDateTime")
dtmStartDate.SetVarDate dateadd("s", -10, now()) ' CONVERT_TO_LOCAL_TIME
dtmEndDate.SetVarDate now() ' CONVERT_TO_LOCAL_TIME
var_wql = "SELECT * FROM Win32_NTLogEvent WHERE (TimeWritten >= '" & dtmStartDate & "') AND (TimeWritten < '" & dtmEndDate & "')"
Set LogFile = objFSO.CreateTextFile(strSystemDrive & "\Temp\EvtLog.txt", True)
Set colLoggedEvents = objWMIService.ExecQuery(var_wql)
For Each objEvent in colLoggedEvents
LogFile.WriteLine "Computer Name : " & objEvent.ComputerName
LogFile.WriteLine "Logfile : " & objEvent.Logfile
LogFile.WriteLine "Type : " & objEvent.Type
LogFile.WriteLine "User : " & objEvent.User
LogFile.WriteLine "Category : " & objEvent.Category
LogFile.WriteLine "Category String : " & objEvent.CategoryString
If IsArray(objEvent.Data) Then
For i = 0 To UBound(objEvent.Data)
strData = strData & objEvent.Data(i) & ","
Next
LogFile.WriteLine "Data : " & strData
Else
LogFile.WriteLine "Data : " & objEvent.Data
End If
LogFile.WriteLine "Event Code : " & objEvent.EventCode
LogFile.WriteLine "Event Identifier : " & objEvent.EventIdentifier
LogFile.WriteLine "Message : " & objEvent.Message
LogFile.WriteLine "Record Number : " & objEvent.RecordNumber
LogFile.WriteLine "Source Name : " & objEvent.SourceName
LogFile.WriteLine "Time Generated : " & objEvent.TimeGenerated
LogFile.WriteLine "Time Written : " & objEvent.TimeWritten
If IsArray(objEvent.InsertionStrings) Then
For i = 0 To UBound(objEvent.InsertionStrings)
strInsert = strInsert & objEvent.InsertionStrings(i) & ","
Next
LogFile.WriteLine "Insertion Strings: " & strInsert
Else
LogFile.WriteLine "Insertion Strings: " & objEvent.InsertionStrings
End If
LogFile.WriteLine "----------------------------------------------------------------------------------------------------------"
Next
Output sample (Not all fields used for every event) -
----------------------------------------------------------------------------------------------------------
Computer Name : Randy-PC
Logfile : Application
Type : Information
User :
Category : 0
Category String :
Data :
Event Code : 9019
Event Identifier : 1073750843
Message : The Desktop Window Manager was unable to start because the desktop composition setting is disabled
Record Number : 37395
Source Name : Desktop Window Manager
Time Generated : 20160903031728.000000-000
Time Written : 20160903031728.000000-000
Insertion Strings:
----------------------------------------------------------------------------------------------------------

Outlook VBScript run as rule

I'm a new user, so please go gentle on me.
I have created an Outlook rule that runs the below script which writes some of the email message properties to an SQL table.
The connection is working fine, when I run this as a macro on a selected message, it works fine... but when I leave it to run as a rule, it just keeps writing the currently selected email...
I can't figure out where I'm going wrong...
Code is below :
Sub TEST_TO_SQL(Item As MailItem)
Dim sSubject As String
Dim sTo As String
Dim sFrom As String
Dim sMsgeID As String
Dim sRcvd As Date
Set Item = Application.ActiveExplorer.Selection.Item(1)
sSubject = Item.Subject
sTo = Item.ReceivedByName
sFrom = Item.SenderEmailAddress
sMsgID = Item.EntryID
sRcvd = Item.ReceivedTime
Const adOpenStatic = 3
Const adLockOptimistic = 3
Set objConnection = CreateObject("ADODB.Connection")
Set objRecordSet = CreateObject("ADODB.Recordset")
objConnection.Open _
"Provider=SQLOLEDB;" & _
"Data Source=SQLSERVER\SQLEXPRESS;" & _
"Trusted_Connection=Yes;" & _
"InitialCatalog=SQLDB;" & _
"User ID=sa;Password=password;"
objRecordSet.Open _
"INSERT INTO [SQLDB].[dbo].[EMAIL_Log] (LogCompanyID, LogSubject, LogStartDate, LogEndDate, LogShortDesc, LogLongDesc, LogFrom, LogTo, LogMessageID, LogCategory1)" & _
"VALUES ('11'," & "'" & sSubject & "'" & ", " & "'" & Format(sRcvd, "yyyy-mm-dd hh:mm:ss", vbUseSystemDayOfWeek, vbUseSystem) & "'" & ", '', 'short desc', 'Long Desc', " & "'" & sFrom & "'" & ", " & "'" & sTo & "'" & ", " & "'" & sMsgID & "'" & ", '47')", objConnection, adOpenStatic, adLockOptimistic
End Sub
You're always using the currently selected mail item. Remove the line:
Set Item = Application.ActiveExplorer.Selection.Item(1)
Then Item will be the one passed in to the Sub

VB Script help in writing event logs to excel

I have the below script to fetch the event logs from system and write to an excel. It is running fine on 'Windows 7', but on 'Windows Server 2003', it is taking 7-8 minutes to write the systems logs, and it writes the Application logs within seconds. However there are very few number of errors in the system logs.
Another problem is I am using MyDate = DateAdd("h", -8, Now()) in the script but it fetches logs for more than 12 hours ago. This time calculation is not functioning correctly.
Your help will be highly appreciated.
Here is the script:
Option Explicit
Dim objFSO, objFolder, objFile, objWMI, objItem, objItem1, objItem2 ' Objects
Dim strComputer, strFileName, strFileOpen, strFolder, strPath, oExcel, oWB, oSheet, oSheet1, oSheet2
Dim intEvent, intNumberID, intRecordNum, colLoggedEvents, colLoggedEvents2, colLoggedEvents3, MyDate, dtm, row, row1, row2, Query, ServerTime
MyDate = DateAdd("h", -8, Now())
'---------------------------------------------------------
On Error Resume Next
Set oExcel=CreateObject("Excel.Application")
oExcel.Visible=true
Set oWB=oExcel.Workbooks.Open ("D:\EventLogs2.xls")
Set oSheet=oWB.Worksheets.Add ( , oWB.WorkSheets(oWB.WorkSheets.Count))
Set oSheet1=oWB.Worksheets.Add ( , oWB.WorkSheets(oWB.WorkSheets.Count))
Set oSheet2=oWB.Worksheets.Add ( , oWB.WorkSheets(oWB.WorkSheets.Count))
oSheet.Name="Application"
oSheet1.Name="Security"
oSheet2.Name="System"
strComputer = "."
ServerTime = Now
intRecordNum = 0
row = 0
row1 = 0
row2 = 0
' ----------------------------------------------------------
' WMI Core Section
Set objWMI = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate,(Security)}!\\" _
& strComputer & "\root\cimv2")
Set colLoggedEvents = objWMI.ExecQuery _
("SELECT * FROM Win32_NTLogEvent where Logfile = 'Application' and " _
& "EventType = '1' and TimeWritten > '" & MyDate & "'")
Set colLoggedEvents2 = objWMI.ExecQuery _
("SELECT * FROM Win32_NTLogEvent where Logfile = 'Security' and " _
& "EventType = '1' and TimeWritten > '" & MyDate & "'")
Set colLoggedEvents3 = objWMI.ExecQuery _
("SELECT * FROM Win32_NTLogEvent where Logfile = 'System' and " _
& "EventType = '1' and TimeWritten > '" & MyDate & "'")
' ----------------------------------------------------------
' Next section loops through ID properties
For Each objItem in colLoggedEvents
If objItem.EventType=1 then
row = row+1
osheet.Cells(row,1).Value = ("Logfile: " & objItem.Logfile _
& " source " & objItem.SourceName)
osheet.Cells(row,2).Value = ("Message: " & objItem.Message)
osheet.Cells(row,3).Value = ("TimeGenerated: " & WMIDateStringToDate(objItem.TimeGenerated))
osheet.Cells(row,4).Value = ServerTime
End If
Next
For Each objItem1 in colLoggedEvents2
If objItem1.EventType=1 then
row1 = row1+1
osheet1.Cells(row1,1).Value = ("Logfile: " & objItem1.Logfile _
& " source " & objItem1.SourceName)
osheet1.Cells(row1,2).Value = ("Message: " & objItem1.Message)
osheet1.Cells(row1,3).Value = ("TimeGenerated: " & WMIDateStringToDate(objItem1.TimeGenerated))
osheet1.Cells(row1,4).Value = ServerTime
End If
Next
For Each objItem2 in colLoggedEvents3
If objItem2.EventType=1 then
row2 = row2+1
osheet2.Cells(row2,1).Value = ("Logfile: " & objItem2.Logfile _
& " source " & objItem2.SourceName)
osheet2.Cells(row2,2).Value = ("Message: " & objItem2.Message)
osheet2.Cells(row2,3).Value = ("TimeGenerated: " & WMIDateStringToDate(objItem2.TimeGenerated))
osheet2.Cells(row2,4).Value = ServerTime
intRecordNum = intRecordNum +1
End If
Next
Function WMIDateStringToDate(dtmDate)
WMIDateStringToDate = CDate(Mid(dtmDate, 5, 2) & "/" & _
Mid(dtmDate, 7, 2) & "/" & Left(dtmDate, 4) _
& " " & Mid (dtmDate, 9, 2) & ":" & Mid(dtmDate, 11, 2) & ":" & Mid(dtmDate,13, 2))
End Function
oWB.save
oWB.Application.Quit
WScript.Quit
Can't you just write to a CSV file?
Something like this:
Option Explicit
Dim objFSO, objFolder, objFile, objWMI, objItem, objItem1, objItem2 ' Objects
Dim strComputer, strFileName, strFileOpen, strFolder, strPath, oExcel, oWB, oSheet, oSheet1, oSheet2
Dim intEvent, intNumberID, intRecordNum, colLoggedEvents, colLoggedEvents2, colLoggedEvents3, MyDate, dtm, row, row1, row2, Query, ServerTime
MyDate = DateAdd("h", -8, Now())
'---------------------------------------------------------
On Error Resume Next
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile("D:\EventLogs2.csv", True)
strComputer = "."
ServerTime = Now
intRecordNum = 0
row = 0
row1 = 0
row2 = 0
' ----------------------------------------------------------
' WMI Core Section
Set objWMI = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate,(Security)}!\\" _
& strComputer & "\root\cimv2")
Set colLoggedEvents = objWMI.ExecQuery _
("SELECT * FROM Win32_NTLogEvent where Logfile = 'Application' and " _
& "EventType = '1' and TimeWritten > '" & MyDate & "'")
Set colLoggedEvents2 = objWMI.ExecQuery _
("SELECT * FROM Win32_NTLogEvent where Logfile = 'Security' and " _
& "EventType = '1' and TimeWritten > '" & MyDate & "'")
Set colLoggedEvents3 = objWMI.ExecQuery _
("SELECT * FROM Win32_NTLogEvent where Logfile = 'System' and " _
& "EventType = '1' and TimeWritten > '" & MyDate & "'")
' ----------------------------------------------------------
' Next section loops through ID properties
For Each objItem in colLoggedEvents
If objItem.EventType=1 then
objFile.WriteLine("Logfile: " & objItem.Logfile & "," & " source " & objItem.SourceName & "," & _
"Message: " & objItem.Message & "," & _
"TimeGenerated: " & WMIDateStringToDate(objItem.TimeGenerated) & "," & _
ServerTime)
End If
Next
For Each objItem1 in colLoggedEvents2
If objItem1.EventType=1 then
objFile.WriteLine("Logfile: " & objItem1.Logfile & "," & " source " & objItem1.SourceName & "," & _
"Message: " & objItem1.Message & "," & _
"TimeGenerated: " & WMIDateStringToDate(objItem1.TimeGenerated) & "," & _
ServerTime)
End If
Next
For Each objItem2 in colLoggedEvents3
If objItem2.EventType=1 then
objFile.WriteLine("Logfile: " & objItem2.Logfile & "," & " source " & objItem2.SourceName & "," & _
"Message: " & objItem2.Message & "," & _
"TimeGenerated: " & WMIDateStringToDate(objItem2.TimeGenerated) & "," & _
ServerTime)
End If
Next
Function WMIDateStringToDate(dtmDate)
WMIDateStringToDate = CDate(Mid(dtmDate, 5, 2) & "/" & _
Mid(dtmDate, 7, 2) & "/" & Left(dtmDate, 4) _
& " " & Mid (dtmDate, 9, 2) & ":" & Mid(dtmDate, 11, 2) & ":" & Mid(dtmDate,13, 2))
End Function
objFile.Close
Set objFile = Nothing
Set objFSO = Nothing

What's causing Microsoft VBScript runtime error '800a01a8'

I am getting this specific error, help would be appreciated
Microsoft VBScript runtime error '800a01a8'
Object required: 'openRecordSet(...)'
/admin/users/affiliates/process.asp, line 47
Line 47 is Set objRecordset = openRecordset(strSQL, objConnection)
<%
SetUserLevel(" 2 ")
If (InStr(Request.ServerVariables("HTTP_REFERER"), "://jim/admin/users/affiliate") = 0) Then
Response.Redirect( "/admin/users/affiliate/" )
End If
Dim objConnection, objRecordset, strSQL, Affiliate_ID
If (IsEmpty(Request.Form("Affiliate_ID")) Or RTrim(Request.Form("Affiliate_ID")) = "") Then
Affiliate_ID = 0
Else
Affiliate_ID = prepareSQL(Request.Form("Affiliate_ID"))
End If
strSQL = "EXEC sp_User_Add_Affiliate " & _
Session("User_ID") & ", '" & _
prepareSQL(Request.Form("First_Name")) & "', '" & _
prepareSQL(Request.Form("Middle_Initial")) & "', '" & _
prepareSQL(Request.Form("Last_Name")) & "', '" & _
prepareSQL(Request.Form("Email_Address")) & "', '" & _
Request.ServerVariables("REMOTE_ADDR") & "', " & _
Session.SessionID & ", '" & _
prepareSQL(Request.Form("Address_1")) & "', '" & _
prepareSQL(Request.Form("Address_2")) & "', '" & _
prepareSQL(Request.Form("City")) & "', '" & _
prepareSQL(Request.Form("State")) & "', '" & _
prepareSQL(Request.Form("Zip")) & "', '" & _
prepareSQL(Request.Form("Country")) & "', '" & _
prepareSQL(Request.Form("Phone")) & "', '" & _
prepareSQL(Request.Form("Phone_Extension")) & "', '" & _
prepareSQL(Request.Form("Fax")) & "', '" & _
prepareSQL(Request.Form("Company")) & "', '" & _
prepareSQL(Request.Form("Pay_To")) & "', '" & _
prepareSQL(Request.Form("Tax_ID")) & "', '" & _
prepareSQL(Request.Form("Tax_ID_Type")) & "', '" & _
prepareSQL(Request.Form("Tax_Class")) & "', " & _
Affiliate_ID & "," & _
Request.Form("ID") & "," & _
Request.Form("Approved")
Set objConnection = openConnectionAdmin()
Set objRecordset = openRecordset(strSQL, objConnection)
If objRecordset("Error") = "1" Then
Response.Write objRecordset("Data")
Response.End
End If
objRecordset.Close
Set objRecordset = Nothing
Set objConnection = Nothing
Response.Redirect ( "/admin/users/affiliates/" ) %>
Function openRecordSet(ByVal strSQL, ByRef objConnection)
On Error Resume Next
' logSQL(strSQL)
Set openRecordset = objConnection.Execute(strSQL)
If err.Number <> 0 Then
'Response.Write Err.Number & " - " & Err.Description logError("ASP: openRecordset: " & Err.Number & " - " & Err.Description & ": " & strSQL)
' Call displayErrorPage()
End If
End Function
The error typically is caused by using Set to indicate assignment of an object to a variable, but having a non-object for the right value:
>> Set v = New RegExp
>> [no news here are good news]
>> Set v = "a"
>>
Error Number: 424
Error Description: Object required
So check your openRecordset function. Does it return a recordset by executing
Set openRecordset = ....
(mark the Set) for the given parameters?
Update wrt comments:
This test script:
Option Explicit
' How to test the type of a function's return value that should
' be an object but sometimes isn't. You can't assign the return value
' to a variable because of VBScript's disgusting "Set".
WScript.Echo "TypeName(openConnectionAdmin()): ", TypeName(openConnectionAdmin())
WScript.Echo "TypeName(openRecordset(...)) : ", TypeName(openRecordset("", objConnection))
' Trying to create a connection and a recordset
Dim objConnection : Set objConnection = openConnectionAdmin()
Dim objRecordset : Set objRecordset = openRecordset("", objConnection)
Function openConnectionAdmin()
' Set openConnectionAdmin = CreateObject("ADODB.CONNECTION")
Set openConnectionAdmin = Nothing
End Function
' After removing the comments: Obviously this is a function that
' hides all errors; the programmer should be fed to the lions.
Function openRecordSet(ByVal strSQL, ByRef objConnection)
On Error Resume Next
Set openRecordset = objConnection.Execute(strSQL)
End Function
output:
TypeName(openConnectionAdmin()): Connection
TypeName(openRecordset(...)) : Empty
... Microsoft VBScript runtime error: Object required: 'openRecordset(...)'
or
TypeName(openConnectionAdmin()): Nothing
TypeName(openRecordset(...)) : Empty
... Microsoft VBScript runtime error: Object required: 'openRecordset(...)'
shows: By hiding every conceivable error in openRecordset() the function can return Empty (undetected!), which isn't an object and can't be assigned to a variable by using Set.

Runtime error 3704

In my vb6 I am getting error 3704 operation is not allowed when object is closed.
I have search stackoverflow for similar problem but I think I'm missing something. I need to update every row in vfp based from recordset rs1 Here my code:
Option Explicit
Dim cn As New ADODB.Connection
Dim cn1 As New ADODB.Connection
Private Sub trns_Click()
Set cn = New ADODB.Connection
Set cn1 = New ADODB.Connection
cn.ConnectionString = MDI1.txtcn.Text
cn.Open
cn1.ConnectionString = "Provider=VFPOLEDB;Data Source=\\host1\software\MIL\company0"
cn1.Open
rs1.Open "Select * from trans", cn, adOpenStatic, adLockPessimistic
Do While Not rs2.EOF
rs2.Open "update transac set no_ot_1_5 = " & rs1.Fields("ovt1") & ", no_ot_2_0 = " & rs1.Fields("ovt2") & ", no_ot_3_0" _
& "= " & rs1.Fields("ovt3") & ",Meal_allw = " & rs1.Fields("meal_allow") & ",on_duty = " & rs1.Fields("cnt") & ",no_d_local = " & rs1.Fields("local") & ",no_d_sick" _
& "= " & rs1.Fields("sick") & ",no_d_abs = " & rs1.Fields("absence") & ",no_d_spc = " & rs1.Fields("special") & ",Revenue02" _
& "= " & rs1.Fields("refund") & ",Revenue05 = " & rs1.Fields("prepay") & ",Deduct05 = " & rs1.Fields("prepay") & ",Revenue01 = " & rs1.Fields("comm") & "where code = '" & rs1.Fields("emp_code") & "' and transac.date = CTOD('" & trans.txtend2 & "')", cn1, adOpenDynamic, adLockPessimistic
If Not rs2.EOF Then
rs2.MoveNext
End If
Loop
rs2.close
Update query doesn't return recordset, hence your rs2 is not opened.
You perform your loop on the wrong recordeset : I replaced the some of the rs2 with rs1 in your code.
Do While Not rs1.EOF
rs2.Open "update transac set no_ot_1_5 = " & rs1.Fields("ovt1") & ", no_ot_2_0 = " & rs1.Fields("ovt2") & ", no_ot_3_0" _
& "= " & rs1.Fields("ovt3") & ",Meal_allw = " & rs1.Fields("meal_allow") & ",on_duty = " & rs1.Fields("cnt") & ",no_d_local = " & rs1.Fields("local") & ",no_d_sick" _
& "= " & rs1.Fields("sick") & ",no_d_abs = " & rs1.Fields("absence") & ",no_d_spc = " & rs1.Fields("special") & ",Revenue02" _
& "= " & rs1.Fields("refund") & ",Revenue05 = " & rs1.Fields("prepay") & ",Deduct05 = " & rs1.Fields("prepay") & ",Revenue01 = " & rs1.Fields("comm") & "where code = '" & rs1.Fields("emp_code") & "' and transac.date = CTOD('" & trans.txtend2 & "')", cn1, adOpenDynamic, adLockPessimistic
If Not rs1.EOF Then
rs1.MoveNext
End If
Loop
rs1.close
You dont need to create a recordset to execute an update, insert or delete on the database. Just use the statement cn1.Execute YourSqlStatement where YourSqlStatement is the string you are passing on the rs2.Open instruction. The Execute method on the connection optionally accepts a byRef variable where you can get the number of records affected.
Example:
Dim nRecords As Integer
cn1.Execute "Update Table Set Field = Value Where AnotherField = SomeValue ", nRecords
MsgBox "Total Updated Records: " & Format(nRecords,"0")
try to open your rs2 before using if in the do while statement., or do it like this
rs2.open " blah blah blah "
Do Until rs2.eof
For Each fld In rs2.field
value_holder = fld.value
Next
rs2.movenext
Loop

Resources