I have two recordset which want to update one of them by value of the other. I did like this
stSql = "SELECT dbo.tblCableProperty.CatalogCode FROM dbo.tblCable INNER JOIN " & _
" dbo.tblCableProperty ON dbo.tblCable.CablePcode = dbo.tblCableProperty.CablePcode" & _
" WHERE dbo.tblCable.prjsubcode=" & prjsubcode & " AND dbo.tblCable.Active=1 " & " And dbo.tblCable.Gtag='" & Gtag & "' And dbo.tblCable.TagNo=" & tagno & " And dbo.tblCable.NTag=" & NTag & " And dbo.tblCable.EndStr='" & EndStr & "'"
rs.Open stSql, cn, adOpenStatic, adLockOptimistic
catalogCode = rs!catalogCode
rs.Close
stSql = "SELECT *,'' as ShowNum FROM viwShowNum WHERE prjsubcode=" & prjsubcode & " AND Active=1 " & " And Gtag='" & Gtag & "' And TagNo=" & tagno & " And NTag=" & NTag & " And EndStr='" & EndStr & "' ORDER BY 8"
rs.Open stSql, cn, adOpenDynamic, adLockOptimistic
rs.MoveFirst
stSql = "Select * from tblCoreCode where CatalogCode=" & catalogCode
Set rsCoreCode = New ADODB.Recordset
rsCoreCode.CursorLocation = adUseClient
rsCoreCode.Open stSql, cn, adOpenStatic, adLockOptimistic
While Not rs.EOF
criteria = "RealNum='" & rs!CoreNo & "'"
rsCoreCode.Filter = criteria
rs!ShowNum = CStr(rsCoreCode!ShowNum)
rsCoreCode.Filter = adFilterNone
rs.MoveNext
Wend
I get the following error on this part
rs!ShowNum = CStr(rsCoreCode!ShowNum)
multiple-step operation generated errors. check each status value
rsCoreCode!ShowNum is varchar(5). I tried to set the value
rs!ShowNum = "1"
but again I got the same error.
where is the problem?
Thank you
As asked in my comment, if rs.Updatable or rs!ShowNum.DataUpdatable are false, you can use this piece of code from Microsoft to retrieve an updatable RecordSet.
Same issue occurred to me the problem was that i violated an object property , in my case it was size the error came out as
"IntegrationException: Problem (Multiple-step operation generated errors. Check each status value.)"
Imports ADODB
Dim _RecordSet As Recordset
_rs.Fields.Append("Field_Name", DataTypeEnum.adVarChar, 50)
_Recordset("Field_Name").Value = _RecordDetails.Field_NameValue
_RecordDetails.Field_NameValue length was more than 50 chars , so this property was violated , hence the error occurred , so you should probably check if you didn't match one of the properties
Related
i'm in the process of roughing out a proof of concept for desktop software i'd like to develop. I'm using Access 2013.
The following code is supposed to analyse records in one table ('tblRestructures') and depending on the analysis it should then populate records in another table ('tblInScopeRestructures'). The sample data in tblRestructures is set up such that the code should cause there to be records with field(Gen) with values 1 to 6 inclusive. Sometimes the code does succeed in populating tblInScopeRestructures as expected but other times the code ends early (ie conditions for ending various loops are met). Despite a lot of time spent trying to identify the cause of the variability and looking for similar questions here, I am still none the wiser.
Any help here is gratefully received. And I apologise up front for my ugly code - I am not experienced and at this stage I am just trying to speed through a proof of concept.
Here is the code:
Public Function NbrOfShares3(strCode As String, dteDate As Date) As Single
Dim i As Integer
Dim strPrevCode1 As String
Dim adConn As ADODB.Connection
Set adConn = New ADODB.Connection
adConn.Open CurrentProject.Connection
Dim adrsa As ADODB.Recordset
Set adrsa = New ADODB.Recordset
adConn.Execute "DELETE * from tblInScopeRestructures"
adrsa.ActiveConnection = CurrentProject.Connection
adrsa.CursorType = adOpenStatic
' Identify all gen 1 (Code1 = CODE) restructures up to dteDate and put in a temp table
adrsa.Open "SELECT tblRestructure.Code1, tblRestructure.Code2, tblRestructure.RecDate " & _
"FROM tblRestructure " & _
"WHERE (((tblRestructure.Code1)='" & strCode & "')) AND (((tblRestructure.RecDate)<=#" & Format(dteDate, "mm/dd/yyyy") & "#));"
If adrsa.RecordCount <> 0 Then
adrsa.MoveFirst
Do While Not adrsa.EOF
adConn.Execute ("INSERT INTO tblInScopeRestructures(Code1,Code2,RecDate,Gen) VALUES ('" & adrsa.Fields("Code1") & "','" & adrsa.Fields("Code2") & _
"',#" & Format(adrsa.Fields("RecDate"), "mm/dd/yyyy") & "#," & 1 & ")")
adrsa.MoveNext
Loop
End If
i = 0
'Identify all code1 in
Dim adrsb As ADODB.Recordset
Set adrsb = New ADODB.Recordset
adrsb.ActiveConnection = CurrentProject.Connection
Do
i = i + 1
If adrsb.State = 1 Then
adrsb.Close
End If
adrsb.CursorType = adOpenStatic
adrsb.Open "SELECT tblInScopeRestructures.Code1, tblInScopeRestructures.Gen " & _
"FROM tblInScopeRestructures " & _
"GROUP BY tblInScopeRestructures.Code1, tblInScopeRestructures.Gen " & _
"HAVING (((tblInScopeRestructures.Gen)=" & i & "));"
Dim adrsc As ADODB.Recordset
Set adrsc = New ADODB.Recordset
adrsc.ActiveConnection = CurrentProject.Connection
adrsc.CursorType = adOpenStatic
If Not adrsb.EOF Then
adrsb.MoveLast
adrsb.MoveFirst
End If
If adrsb.RecordCount <> 0 Then
adrsb.MoveFirst
strPrevCode1 = adrsb.Fields("Code1")
Do While Not adrsb.EOF
If adrsc.State = 1 Then
adrsc.Close
End If
adrsc.CursorType = adOpenStatic
adrsc.Open "SELECT tblRestructure.Code1, tblRestructure.Code2, tblRestructure.RecDate " & _
"FROM tblRestructure " & _
"WHERE (((tblRestructure.Code2)='" & strPrevCode1 & "'));"
If adrsc.RecordCount <> 0 Then
adrsc.MoveFirst
Do While Not adrsc.EOF
adConn.Execute ("INSERT INTO tblInScopeRestructures(Code1,Code2,RecDate,Gen) VALUES ('" & adrsc.Fields("Code1") & "','" & adrsc.Fields("Code2") & _
"',#" & Format(adrsc.Fields("RecDate"), "mm/dd/yyyy") & "#," & i + 1 & ")")
adrsc.MoveNext
Loop
End If
adrsb.MoveNext
Loop
End If
Loop While adrsb.RecordCount <> 0
Debug.Print "finished"
End Function
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
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
I have a routine which reads one recordset, and adds/updates rows in a similar recordset. The routine starts off by copying the columns to a new recordset:
Here's the code for creating the new recordset..
For X = 1 To aRS.Fields.Count
mRS.Fields.Append aRS.Fields(X - 1).Name, aRS.Fields(X - 1).Type, aRS.Fields(X - _
1).DefinedSize, aRS.Fields(X - 1).Attributes
Next X
Pretty straight forward. Notice the copying of the name, Type, DefinedSize & Attributes...
Further down in the code, (and there's nothing that modifies any of the columns between.. ) I'm copying the values of a row to a row in the new recordset as such:
For C = 1 To aRS.Fields.Count
mRS.Fields(C - 1) = aRS.Fields(C - 1)
Next C
When it gets to the last column which is a numeric, it craps with the "Mutliple-Step Operation Generated an error" message.
I know that MS says this is an error generated by the provider, which in this case is ADO 2.8. There is no open connect to the DB at this point in time either.
I'm pulling what little hair I have left over this one... (and I don't really care at this point that the column index is 'X' in one loop & 'C' in the other... I'll change it later when I get the real problem fixed...)
You have to set Precision and NumericScale for adDecimal and adNumeric fields before opening synthetic recordset like this
For X = 1 To aRS.Fields.Count
With aRS.Fields(X - 1)
Select Case .Type
Case adChar, adWChar, adBinary, _
adVarChar, adVarWChar, adVarBinary, _
adLongVarChar, adLongVarWChar, adLongVarBinary
mRS.Fields.Append .Name, .Type, .DefinedSize, .Attributes
Case adDecimal, adNumeric
mRS.Fields.Append .Name, .Type, , .Attributes
mRS.Fields(mRS.Fields.Count - 1).Precision = .Precision
mRS.Fields(mRS.Fields.Count - 1).NumericScale = .NumericScale
Case Else
mRS.Fields.Append .Name, .Type, , .Attributes
End Select
End With
Next
FYI: you might be get a recordset with a field that has no name from the database e.g.
SELECT 5, 'No name'
but ADO will not allow an empty name on Append method. You might also get a recordset with duplicate fields from the database e.g.
SELECT 5 AS Col, 'Second' AS Col
which in your case will bomb out on Append too.
Guess 2 : the correct line should be
mRS.Fields(C - 1).value = aRS.Fields(C - 1).value
My guess is you have have a null and you are not treating the dbnull type right.
Please see my comments about finding an alternative approach but the straight answer is the Field objects' Precision and NumericScale properties need to be set. Here's a repro of your error, uncomment the two lines to fix the error:
Sub bfgosdb()
On Error Resume Next
Kill Environ$("temp") & "\DropMe.mdb"
On Error GoTo 0
Dim cat
Set cat = CreateObject("ADOX.Catalog")
With cat
.Create _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & _
Environ$("temp") & "\DropMe.mdb"
With .ActiveConnection
Dim Sql As String
Sql = _
"CREATE TABLE Test1 " & vbCr & "(" & vbCr & " col1 VARCHAR(255)," & _
" " & vbCr & " col2 INTEGER, " & vbCr & " col3 DECIMAL(19,4)" & vbCr & ");"
.Execute Sql
Sql = _
"INSERT INTO Test1 (col1, col2, col3) " & vbCr & "VALUES" & _
" (" & vbCr & "'128000 and some change', " & vbCr & "128000, " & vbCr & "128000.1234" & vbCr & ");"
.Execute Sql
Sql = _
"INSERT INTO Test1 (col1, col2, col3) " & vbCr & "VALUES" & _
" (" & vbCr & "NULL, " & vbCr & "NULL, " & vbCr & "NULL " & vbCr & ");"
.Execute Sql
Sql = _
"SELECT T11.col1, T11.col2, T11.col3 " & vbCr & " FROM" & _
" Test1 AS T11;"
Dim aRS
Set aRS = .Execute(Sql)
Dim mRS
Set mRS = CreateObject("ADODB.Recordset")
Dim X As Long
For X = 1 To aRS.Fields.Count
mRS.Fields.Append aRS.Fields(X - 1).Name, aRS.Fields(X - 1).Type, aRS.Fields(X - _
1).DefinedSize, aRS.Fields(X - 1).Attributes
' mRS.Fields(mRS.Fields.Count - 1).NumericScale = aRS.Fields(X - 1).NumericScale '
' mRS.Fields(mRS.Fields.Count - 1).Precision = aRS.Fields(X - 1).Precision '
Next X
mRS.Open
Do While Not aRS.EOF
mRS.AddNew
Dim C As Long
For C = 1 To aRS.Fields.Count
mRS.Fields(C - 1) = aRS.Fields(C - 1)
Next C
aRS.MoveNext
Loop
End With
Set .ActiveConnection = Nothing
End With
End Sub
I am trying to execute the query which stores recordset vales in sql db. when I am trying to execute that i am getting error like
the connection cannt be used to perform this operation. It may closed or not valid in this context error in vb6. Please help me to solve this issue.
' Write records to Database
frmDNELoad.lblStatus.Caption = "Loading data into database......"
Call FindServerConnection_NoMsg
Dim lngRecCount As Long
lngRecCount = 0
rcdDNE.MoveFirst
Set rcdReclamation = New ADODB.Recordset
With rcdReclamation
.ActiveConnection = objConn
.Source = "insert into t_DATA_DneFrc (RTN, AccountNbr, FirstName, MiddleName, LastName, Amount) values ('" & rcdDNE("RTN") & "', '" & rcdDNE("AccountNbr") & "', '" & rcdDNE("FirstName") & "', '" & rcdDNE("MiddleName") & "', '" & rcdDNE("LastName") & "', '" & rcdDNE("Amount") & "')"
.CursorType = adOpenDynamic
.CursorLocation = adUseClient
.LockType = adLockOptimistic
.Open cmdCommand
End With
Do Until rcdDNE.EOF
lngRecCount = lngRecCount + 1
frmDNELoad.lblStatus.Caption = "Adding record " & lngRecCount & " of " & rcdDNE.RecordCount & " to database."
frmDNELoad.Refresh
DoEvents
Call CommitNew
rcdDNE.MoveNext
Loop
frmDNELoad.lblStatus.Caption = "DNE Processing Complete."
frmDNELoad.Refresh
End Function
Sub CommitNew()
' Add records to DneFrc table
With rcdReclamation
.Requery
.AddNew
.Fields![RTN] = rcdDNE.Fields![RTN]
.Fields![AccountNbr] = rcdDNE.Fields![AccountNbr]
.Fields![FirstName] = rcdDNE.Fields![FirstName]
.Fields![MiddleName] = rcdDNE.Fields![MiddleName]
.Fields![LastName] = rcdDNE.Fields![LastName]
.Fields![Amount] = rcdDNE.Fields![Amount]
.Update
End With
End Sub
conection code
Sub InstantiateCommand_SQLText()
' Creates a command object to be used when executing SQL statements.
Set objCommSQLText = New ADODB.Command
objCommSQLText.ActiveConnection = objConn
objCommSQLText.CommandType = adCmdText
End Sub
Function FindServerConnection_NoMsg() As String
Dim rcdClientPaths As ADODB.Recordset
Dim strDBTemp As String
Const CLIENT_UPDATE_DIR = "\\PSGSPHX02\NORS\Rs\ClientUpdate\"
On Error Resume Next
' If persisted recordset is not there, try and copy one down from
' CLIENT_UPDATE_DIR. If that can't be found, create a blank one
' and ask the user for the server name.
Set rcdClientPaths = New ADODB.Recordset
' Does it already exist locally?
If FileExists_FullPath(App.Path & "\" & "t_PCD_ServerConnectionList.xml") = False Then
' Can it be retrieved from CLIENT_UPDATE_DIR
If Dir(CLIENT_UPDATE_DIR & "t_PCD_ServerConnectionList.xml") "" Then
FileCopy CLIENT_UPDATE_DIR & "t_PCD_ServerConnectionList.xml", App.Path & "\" & "t_PCD_ServerConnectionList.xml"
Else
' Creat a blank one.
With rcdClientPaths
.Fields.Append "ServerConnection", adVarChar, 250
.Fields.Append "Description", adVarChar, 50
.CursorType = adOpenDynamic
.LockType = adLockOptimistic
.CursorLocation = adUseClient
.Open
.Save App.Path & "\" & "t_PCD_ServerConnectionList.xml", adPersistXML
.Close
End With
End If
End If
' Open the recordset
With rcdClientPaths
.CursorType = adOpenDynamic
.LockType = adLockOptimistic
.CursorLocation = adUseClient
.Open App.Path & "\" & "t_PCD_ServerConnectionList.xml", , , , adCmdFile
End With
If rcdClientPaths.RecordCount 0 Then
' try each one listed
rcdClientPaths.MoveFirst
Do Until rcdClientPaths.EOF
strDBTemp = TryConnection_NoMsg(rcdClientPaths.Fields![serverconnection])
If strDBTemp "" Then
FindServerConnection_NoMsg = strDBTemp
Exit Function
End If
rcdClientPaths.MoveNext
Loop
strDBTemp = ""
End If
Do While strDBTemp = ""
If strDBTemp "" Then
strDBTemp = TryConnection_NoMsg(strDBTemp)
If strDBTemp "" Then
With rcdClientPaths
.AddNew
.Fields![serverconnection] = strDBTemp
.Update
.Save
End With
FindServerConnection_NoMsg = strDBTemp
Exit Function
End If
Else
Exit Function
End If
Loop
End Function
Function TryConnection_NoMsg(ByVal SvName As String) As String
On Error GoTo ErrHandle
' If a server was provided, try to open a connection to it.
Screen.MousePointer = vbHourglass
Set objConn = New ADODB.Connection
With objConn
.CommandTimeout = 30
.ConnectionTimeout = 30
.ConnectionString = "Provider=SQLOLEDB.1; Server=" & SvName & "; User ID=RS_Auth; Password=weLcomers_auth; Initial Catalog=NORS" ' Test
.Open
.Close
End With
Set objConn = Nothing
TryConnection_NoMsg = SvName
Screen.MousePointer = vbNormal
Exit Function
ErrHandle:
TryConnection_NoMsg = ""
Set objConn = Nothing
Screen.MousePointer = vbNormal
Exit Function
End Function
You have already closed the connection here in TryConnection_NoMsg function (?)
With objConn
.CommandTimeout = 30
.ConnectionTimeout = 30
.ConnectionString = "Provider=SQLOLEDB.1; Server=" & SvName & "; Database=NORS; User ID=RS_Auth; Password=weLcomers_auth; Initial Catalog=NORS" ' Test
.Open
.Close
I'd suspect that FindServerConnection_NoMsg is not managing to open the connection, and since it ends in NoMsg that you're not seeing the error about why the connection wasn't opened. You then go on to just use the connection without knowing that the open failed.
Post the code for FindServerConnection_NoMsg.
BTW, your question itself should have given you a clue. It specifically says that the connection can't be used, and that it may not be open. That should have told you where to start looking, and at the least told you you should have posted the code that opened the connection as part of your question.
Thanks for everyone. I sloved my problem. This what i cahnge in my code
Dim lngRecCount As Long
lngRecCount = 0
rcdDNE.MoveFirst
With cmdCommand
.ActiveConnection = objConn
.CommandText = "insert into t_DATA_DneFrc (RTN, AccountNbr, FirstName, MiddleName, LastName, Amount) values ('" & rcdDNE("RTN") & "', '" & rcdDNE("AccountNbr") & "', '" & rcdDNE("FirstName") & "', '" & rcdDNE("MiddleName") & "', '" & rcdDNE("LastName") & "', '" & rcdDNE("Amount") & "')"
.CommandType = adCmdText
End With
Set rcddnefrc = New ADODB.Recordset
With rcddnefrc
.ActiveConnection = objConn
.Source = "SELECT * FROM T_DATA_DNEFRC"
.CursorType = adOpenDynamic
.CursorLocation = adUseClient
.LockType = adLockOptimistic
.Open
End With
Do Until rcdDNE.EOF
lngRecCount = lngRecCount + 1
frmDNELoad.lblStatus.Caption = "Adding record " & lngRecCount & " of " & rcdDNE.RecordCount & " to database."
frmDNELoad.Refresh
DoEvents
Call CommitNew
rcdDNE.MoveNext
Loop
frmDNELoad.lblStatus.Caption = "DNE Processing Complete."
frmDNELoad.Refresh