missing values from sub (1 Viewer)

btamsgn

Member
Local time
Today, 11:44
Joined
Nov 8, 2010
Messages
51
Hi everyone,
Pls fix missing values from the 28th records to 45th into table tbltke(vitriD)
from sub as belows:
Sub dkepos45(tablea As String)
Dim i As Integer
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim dpos(1 To 45) As String
Dim strSQL As String

Set db = CurrentDb

' Fill dPos() with column names D1 to D6 if their values >= 1
strSQL = "SELECT * FROM " & tablea
Set rs = db.OpenRecordset(strSQL)

i = 1
Do While Not rs.EOF And i <= 45
dpos(i) = ""
If rs.Fields("D1").Value >= 1 Then dpos(i) = dpos(i) & "D1,"
If rs.Fields("D2").Value >= 1 Then dpos(i) = dpos(i) & "D2,"
If rs.Fields("D3").Value >= 1 Then dpos(i) = dpos(i) & "D3,"
If rs.Fields("D4").Value >= 1 Then dpos(i) = dpos(i) & "D4,"
If rs.Fields("D5").Value >= 1 Then dpos(i) = dpos(i) & "D5,"
If rs.Fields("D6").Value >= 1 Then dpos(i) = dpos(i) & "D6,"
' Remove trailing comma
If Len(dpos(i)) > 0 Then dpos(i) = Left(dpos(i), Len(dpos(i)) - 1)
rs.MoveNext
i = i + 1
Loop

' Update values dPos() into tablea
For i = 1 To 45
If dpos(i) <> "" Then
strSQL = "UPDATE " & tablea & " SET vitriD = '" & dpos(i) & "' WHERE so45 = " & i
db.Execute strSQL
End If
Next i

Set rs = Nothing
Set db = Nothing
End Sub
 

Attachments

Do you think we are your personal servants? :(
 

Users who are viewing this thread

Back
Top Bottom