I am Saving data in SQL server using WINCC but I can't insert my current data and time Help me to solve this
Sub OnClick(ByVal Item)
Dim objConnection
Dim strConnectionString
Dim lngValue
Dim strSQL
Dim objCommand
strConnectionString = "Provider=MSDASQL;DSN=winnrc;UID=;PWD=;"
lngValue = HMIRuntime.Tags("JOB_ID").Read(1)
strSQL = "INSERT INTO NEWDATA (JOB_ID,SHIFT,QTY,WEIGHT,DECREASING_ST,DECREASING_TEMP_PV,DECREASING_LEVEL,CASCADE_RINSE_T4_ST,CASCADE_RINSE_T4_TEMP_PV,CASCADE_RINSE_T4_LEVEL,CASCADE_RINSE_T3_ST,CASCADE_RINSE_T3_TEMP_PV,CASCADE_RINSE_T3_LEVEL,PHOSPHATE_ST,PHOSPHATE_TEMP_PV,PHOSPHATE_LEVEL,trigger_0) VALUES (" & HMIRuntime.Tags("REPORT_BLOCK_JOB_ID").Read(1) & "," & HMIRuntime.Tags("REPORT_BLOCK_SHIFT").Read(1) & "," & HMIRuntime.Tags("REPORT_BLOCK_QUANTITY").Read(1) & "," & HMIRuntime.Tags("REPORT_BLOCK_WEIGHT").Read(1) & "," & HMIRuntime.Tags("REPORT_BLOCK_DECREASING_ST").Read(1) & "," & HMIRuntime.Tags("REPORT_BLOCK_DECREASING_TEMP_PV").Read(1) & "," & HMIRuntime.Tags("REPORT_BLOCK_DECREASING_LEVEL").Read(1) & "," & HMIRuntime.Tags("REPORT_BLOCK_CASCADE_RINSE_T4_ST").Read(1) & "," & HMIRuntime.Tags("REPORT_BLOCK_CASCADE_RINSE_T4_TEMP_PV").Read(1) & "," & HMIRuntime.Tags("REPORT_BLOCK_CASCADE_RINSE_T4_LEVEL").Read(1) & "," & HMIRuntime.Tags("REPORT_BLOCK_CASCADE_RINSE_T3_ST").Read(1) & "," & HMIRuntime.Tags("REPORT_BLOCK_CASCADE_RINSE_T3_TEMP_PV").Read(1) & "," & HMIRuntime.Tags("REPORT_BLOCK_CASCADE_RINSE_T3_LEVEL").Read(1) & "," & HMIRuntime.Tags("REPORT_BLOCK_PHOSPHATE_ST").Read(1) & "," & HMIRuntime.Tags("REPORT_BLOCK_PHOSPHATE_TEMP_PV").Read(1) & "," & HMIRuntime.Tags("REPORT_BLOCK_PHOSPHATE_LEVEL").Read(1) & "," & HMIRuntime.Tags("trigger_0").Read(1) & ");"
Set objConnection = CreateObject("ADODB.Connection")
objConnection.ConnectionString = strConnectionString
objConnection.Open
Set objCommand = CreateObject("ADODB.Command")
With objCommand
.ActiveConnection = objConnection
.CommandText = strSQL
End With
objCommand.Execute
Set objCommand = Nothing
objConnection.Close
Set objConnection = Nothing
End Sub
Please follow these steps :
1) If you have not added a column for date and time in your table NEWDATA please add a new column name (dt - for instance) and its datatype as datetime
2)Then in the vbscript add the following lines
dim dtat
dtat = now
And rewrite the insert statement as given below :
strSQL = "INSERT INTO NEWDATA(JOB_ID,SHIFT,QTY,WEIGHT,DECREASING_ST,DECREASING_TEMP_PV,DECREASING_LEVEL,CASCADE_RINSE_T4_ST,CASCADE_RINSE_T4_TEMP_PV,CASCADE_RINSE_T4_LEVEL,CASCADE_RINSE_T3_ST,CASCADE_RINSE_T3_TEMP_PV,CASCADE_RINSE_T3_LEVEL,PHOSPHATE_ST,PHOSPHATE_TEMP_PV,PHOSPHATE_LEVEL,trigger_0,dt) VALUES (" & HMIRuntime.Tags("REPORT_BLOCK_JOB_ID").Read(1) & "," & HMIRuntime.Tags("REPORT_BLOCK_SHIFT").Read(1) & "," & HMIRuntime.Tags("REPORT_BLOCK_QUANTITY").Read(1) & "," & MIRuntime.Tags("REPORT_BLOCK_WEIGHT").Read(1) & "," & HMIRuntime.Tags("REPORT_BLOCK_DECREASING_ST").Read(1) & "," & HMIRuntime.Tags("REPORT_BLOCK_DECREASING_TEMP_PV").Read(1) & "," & HMIRuntime.Tags("REPORT_BLOCK_DECREASING_LEVEL").Read(1) & "," & HMIRuntime.Tags("REPORT_BLOCK_CASCADE_RINSE_T4_ST").Read(1) & "," & HMIRuntime.Tags("REPORT_BLOCK_CASCADE_RINSE_T4_TEMP_PV").Read(1) & "," & HMIRuntime.Tags("REPORT_BLOCK_CASCADE_RINSE_T4_LEVEL").Read(1) & "," & HMIRuntime.Tags("REPORT_BLOCK_CASCADE_RINSE_T3_ST").Read(1) & "," & HMIRuntime.Tags("REPORT_BLOCK_CASCADE_RINSE_T3_TEMP_PV").Read(1) & "," & HMIRuntime.Tags("REPORT_BLOCK_CASCADE_RINSE_T3_LEVEL").Read(1) & "," & HMIRuntime.Tags("REPORT_BLOCK_PHOSPHATE_ST").Read(1) & "," & HMIRuntime.Tags("REPORT_BLOCK_PHOSPHATE_TEMP_PV").Read(1) & "," & HMIRuntime.Tags("REPORT_BLOCK_PHOSPHATE_LEVEL").Read(1) & "," & HMIRuntime.Tags("trigger_0").Read(1) & ",convert(datetime,'"&dtat&"',103));"
Hope that helps!
Related
Pretty new to scripting but i managed to put something together where i retrieve free disk space - formatted how i want. then the file is imported to SQL.
the error i am getting is that the output file is being used by the connection. how can i get this to run under one script without errors.. all help is appreciated.
`CONST strComputer = "."
AuditPath = "C:\Users\Pam\Desktop\Khalid.txt"
ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=khalid;Data Source=GRIMLEY"
Set objFSO=CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile(AuditPath,True)
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery ("Select * from Win32_Volume")
Set objConn = CreateObject ("ADODB.Connection")
d = date()
ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=khalid;Data Source=GRIMLEY"
DIM objWMIService, objItem, colItems
DIM AuditPath, txt , strSQL , ConnectionString
txt = "Server" & vbtab & "DriveLetter" & vbtab & "DriveName" & vbtab & "Size" & vbtab & "Used" & vbtab & "Free" & vbtab & "% Free" & vbtab & "Date" & vbcrlf
Server = "ALL_IN_ONE_Final"
For Each objItem In colItems
ObjFile.Write Server & ","
objFile.write objItem.DriveLetter & ","
ObjFile.Write objItem.Label & ","
objFile.write Int(objItem.Capacity /1073741824)\1 & ","
objFile.write Int((objItem.Capacity - objItem.FreeSpace )/1073741824)\1 & ","
objFile.write Int (objItem.FreeSpace /1073741824)\1 & ","
objFile.write ((objItem.FreeSpace/objItem.Capacity) * 100)\1 & "," & vbcrlf
next
WScript.Sleep 8000
Set objConn = CreateObject ("ADODB.Connection")
objConn.Open ConnectionString
strSQL = strSQL & " BULK INSERT Server_Space"
strSQL = strSQL & " FROM 'C:\Users\Pam\Desktop\Khalid.txt' with"
strSQL = strSQL & " ( FIELDTERMINATOR =',', ROWTERMINATOR = '0x0a')"
objConn.Execute strSQL
objConn.Close
WScript.Quit()`
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
I am trying to have my .vbs output be put into columns. However, when I try write the code to organize the output into columns I continue to get an error - Invalid Procedure call or argument: 'Space'
I'm looking for some help on this, thanks!!
Call FindPCsThatUserLoggedInto
Sub FindPCsThatUserLoggedInto()
strUser = InputBox("Enter First Name")
strLast = InputBox("Enter Last Name")
Const ADS_SCOPE_SUBTREE = 2
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
's = "Name" & Chr(9) & "Account Name" & Chr(9) & "Location" & Chr(10) & Chr(13)
's = s & "----" & Chr(9) & "------------" & Chr(9) & "--------" & Chr(10) & Chr(13)
s = RightJustified("Name", 10) & _
RightJustified("Account Name", 15) & _
RightJustified("Location", 15) & _
vbCrLf
objCommand.CommandText = "SELECT ADSPath FROM 'LDAP://dc=hc,dc=company,dc=com' WHERE givenName = '" & strUser & "*' AND sn = '" & strLast & "*'"
Set objRecordSet = objCommand.Execute
If objRecordSet.Recordcount > 0 Then
objRecordSet.MoveFirst
Do Until objRecordSet.EOF
Set objUser = GetObject(objRecordSet.Fields("ADSPath").Value)
's = s & objUser.DisplayName & Chr(9) & objUser.samaccountname & Chr(9) & objUser.PhysicalDeliveryOfficeName & Chr(10) & Chr(13)
' objRecordSet.MoveNext
s = s & _
RightJustified(objUser.DisplayName, 10) & _
RightJustified(objUser.samaccountname, 15) & _
RightJustified(objUser.PhysicalDeliveryOfficeName, 15) & _
vbCrLf
Loop
MsgBox s
Else
MsgBox "No users matching that criteria exist in the HC domain in AD."
End If
End Sub
Function RightJustified(ColumnValue, ColumnWidth)
RightJustified = Space(ColumnWidth - Len(ColumnValue)) & ColumnValue
End Function
This is the code that I added to organize the outputs into columns:
s = RightJustified("Name", 10) & _
RightJustified("Account Name", 15) & _
RightJustified("Location", 15) & _
vbCrLf
And
s = s & _
RightJustified(objUser.DisplayName, 10) & _
RightJustified(objUser.samaccountname, 15) & _
RightJustified(objUser.PhysicalDeliveryOfficeName, 15) & _
vbCrLf
Here is my output:
My guess would be that this is a runtime error due to your data exceeding the specified size?
RightJustified(objUser.DisplayName, 10) & _
RightJustified(objUser.samaccountname, 15) & _
RightJustified(objUser.PhysicalDeliveryOfficeName, 15) & _
vbCrLf
Perhaps this change would be needed:
Function RightJustified(ColumnValue, ColumnWidth)
If Len(ColumnValue) > ColumnWidth Then
ColumnValue = Left(ColumnValue,ColumnWidth)
End If
RightJustified = Space(ColumnWidth - Len(ColumnValue)) & ColumnValue
End Function
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
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