I've got 2 loops. The first gets a list of project files with a status of 190
The second loop is to see if the as laid files are at status 90. The as laid uber number is the same as the project uber number but with an extra digit. The code get the list of projects correctly but when it checks the as laid table it doesn't find any records even if i tell it to look for "like *". I can't see a problem with the code. Could someone please help me.
Private Sub cmdUpdate_Click()
Dim rsProjectMergeList As ADODB.Recordset
Dim rsProjectList As ADODB.Recordset
Dim rsAsLaidList As ADODB.Recordset
Dim strSql As String
Dim strSQL2 As String
Dim ProjectReady As Boolean
Set rsProjectMergeList = New ADODB.Recordset
Set rsProjectList = New ADODB.Recordset
DoCmd.RunSQL "DELETE tblCanMerge.* FROM tblCanMerge;"
strSql = "Select uber, Cevent FROM tblProjectData WHERE cevent=190;"
rsProjectList.Open strSql, CurrentProject.Connection, adOpenStatic, adLockOptimistic
rsProjectMergeList.Open "tblCanMerge", CurrentProject.Connection, adOpenStatic, adLockOptimistic
If rsProjectList.RecordCount > 0 Then
Do
Set rsAsLaidList = New ADODB.Recordset
strSQL2 = "SELECT tblAsLaidData.uber, tblAsLaidData.CEvent FROM tblAsLaidData WHERE (((tblAsLaidData.uber) Like '" & rsProjectList.Fields("uber") & "*'));"
rsAsLaidList.Open strSQL2, CurrentProject.Connection, adOpenStatic, adLockOptimistic
If rsAsLaidList.RecordCount > 0 Then
ProjectReady = True
Do
If rsAsLaidList.Fields("Cevent") <> 90 Then
ProjectReady = False
End If
rsAsLaidList.MoveNext
Loop Until rsAsLaidList.EOF
Else
MsgBox "No As laids"
End If
rsAsLaidList.Close
If ProjectReady = True Then
With rsProjectMergeList
.AddNew
.Fields("ProjectUber") = rsProjectList!Uber
.Update
End With
End If
rsProjectList.MoveNext
Loop Until rsProjectList.EOF
Else
MsgBox "No Project files ready for merge"
End If
rsProjectList.Close
rsProjectMergeList.Close
lisProjects.Requery
End Sub
The second loop is to see if the as laid files are at status 90. The as laid uber number is the same as the project uber number but with an extra digit. The code get the list of projects correctly but when it checks the as laid table it doesn't find any records even if i tell it to look for "like *". I can't see a problem with the code. Could someone please help me.
Private Sub cmdUpdate_Click()
Dim rsProjectMergeList As ADODB.Recordset
Dim rsProjectList As ADODB.Recordset
Dim rsAsLaidList As ADODB.Recordset
Dim strSql As String
Dim strSQL2 As String
Dim ProjectReady As Boolean
Set rsProjectMergeList = New ADODB.Recordset
Set rsProjectList = New ADODB.Recordset
DoCmd.RunSQL "DELETE tblCanMerge.* FROM tblCanMerge;"
strSql = "Select uber, Cevent FROM tblProjectData WHERE cevent=190;"
rsProjectList.Open strSql, CurrentProject.Connection, adOpenStatic, adLockOptimistic
rsProjectMergeList.Open "tblCanMerge", CurrentProject.Connection, adOpenStatic, adLockOptimistic
If rsProjectList.RecordCount > 0 Then
Do
Set rsAsLaidList = New ADODB.Recordset
strSQL2 = "SELECT tblAsLaidData.uber, tblAsLaidData.CEvent FROM tblAsLaidData WHERE (((tblAsLaidData.uber) Like '" & rsProjectList.Fields("uber") & "*'));"
rsAsLaidList.Open strSQL2, CurrentProject.Connection, adOpenStatic, adLockOptimistic
If rsAsLaidList.RecordCount > 0 Then
ProjectReady = True
Do
If rsAsLaidList.Fields("Cevent") <> 90 Then
ProjectReady = False
End If
rsAsLaidList.MoveNext
Loop Until rsAsLaidList.EOF
Else
MsgBox "No As laids"
End If
rsAsLaidList.Close
If ProjectReady = True Then
With rsProjectMergeList
.AddNew
.Fields("ProjectUber") = rsProjectList!Uber
.Update
End With
End If
rsProjectList.MoveNext
Loop Until rsProjectList.EOF
Else
MsgBox "No Project files ready for merge"
End If
rsProjectList.Close
rsProjectMergeList.Close
lisProjects.Requery
End Sub
