Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- select field from table;
- Option Explicit
- Private Sub UpdateNulls()
- Dim rs2 As DAO.Recordset
- Dim tdf As DAO.TableDef
- Dim db As Database
- Dim varii As Variant, strField As String
- Dim strsql As String, strsql2 As String, strsql3 As String
- Dim astrFields As Variant
- Dim intIx As Integer
- Dim field As Variant
- Dim astrvalidcodes As Variant
- Dim found As Boolean
- Dim v As Variant
- Open "C:Documents and SettingsDesktoptestfile.txt" For Input As #1
- varii = ""
- Do While Not EOF(1)
- Line Input #1, strField
- varii = varii & "," & strField
- Loop
- Close #1
- astrFields = Split(varii, ",") 'Element 0 empty
- For intIx = 1 To UBound(astrFields)
- 'Function ListFieldDescriptions()
- Dim cn As New ADODB.Connection, cn2 As New ADODB.Connection
- Dim rs As ADODB.Recordset, rs3 As ADODB.Recordset
- Dim connString As String
- Dim SelectFieldName
- Set cn = CurrentProject.Connection
- SelectFieldName = astrFields(intIx)
- Set rs = cn.OpenSchema(adSchemaColumns, Array(Empty, Empty, Empty, SelectFieldName))
- 'Show the tables that have been selected '
- While Not rs.EOF
- 'Exclude MS system tables '
- If Left(rs!Table_Name, 4) <> "MSys" Then
- strsql = "Select t.* From [" & rs!Table_Name & "] t Inner Join 01UMWELT On t.fall = [01UMWELT].fall Where [01UMWELT].Status = 4"
- End If
- Set rs3 = CurrentDb.OpenRecordset(strsql)
- 'End Function
- strsql2 = "SELECT label.validcode FROM variablen s INNER JOIN label ON s.id=label.variablenid WHERE varname='" & astrFields(intIx) & "'"
- Set db = OpenDatabase("C:Documents and SettingsDesktopCodebook.mdb")
- Set rs2 = db.OpenRecordset(strsql2)
- With rs2
- .MoveLast
- .MoveFirst
- astrvalidcodes = rs2.GetRows(.RecordCount)
- .Close '
- End With
- With rs3
- .MoveFirst
- While Not rs3.EOF
- found = False
- For Each v In astrvalidcodes
- If v = .Fields(0) Then
- found = True
- Debug.Print .Fields(0)
- Debug.Print .Fields(1)
- Exit For
- End If
- Next
- If Not found Then
- msgbox "xxxxxxxxxxxxxxxx"
- End If
- End If
- .MoveNext
- Wend
- End With
- On Error GoTo 0 'End of special handling
- Wend
- Next intIx
- End Sub
- Function ListTablesContainingField()
- Dim cn As New ADODB.Connection, cn2 As New ADODB.Connection
- Dim rs As ADODB.Recordset, rs2 As ADODB.Recordset
- Dim connString As String
- Dim SelectFieldName
- Set cn = CurrentProject.Connection
- SelectFieldName = "Fall" 'For tksy '
- 'Get names of all tables that have a column called 'ID' '
- Set rs = cn.OpenSchema(adSchemaColumns, _
- Array(Empty, Empty, Empty, SelectFieldName))
- 'Show the tables that have been selected '
- While Not rs.EOF
- 'Exclude MS system tables '
- If Left(rs!Table_Name, 4) <> "MSys" Then
- ' Edit for tksy, who is using more than one forum '
- If tdf.Name = "01UMWELT" Then
- strSQL = "Select * From 01UMWELT Where Status = 5"
- Else
- strSQL = "Select a.* From [" & rs!Table_Name _
- & "] a Inner Join 01UMWELT On a.fall = 01UMWELT.fall " _
- & "Where 01UMWELT.Status = 5"
- End If
- Set rs2 = CurrentDb.OpenRecordset(strSQL)
- Do While Not rs2.EOF
- For i = 0 To rs2.Fields.Count - 1
- If IsNull(rs2.Fields(i)) Then
- rs2.Edit
- rs2.Fields(i) = 111111
- rs2.Update
- End If
- Next
- rs2.MoveNext
- Loop
- End If
- rs.MoveNext
- Wend
- rs.Close
- Set cn = Nothing
- End Function
- Sub TableTest
- On Error Goto TableTest_Error
- ' ...code that can fail... '
- Exit Sub
- :TableTest_Error
- If Err.Number = 3061 Then
- Err.Clear()
- DoSomething()
- Else
- MsgBox Err.Description ' or whatever you find appropriate '
- End If
- End Sub
- Sub TableTest
- ' ... fail-safe code ... '
- On Error Resume Next
- ' ...code that can fail... '
- If Err.Number = 3061 Then
- Err.Clear()
- DoSomething()
- Else
- MsgBox Err.Description
- End If
- On Error Goto 0
- ' ...mode fail-safe code... '
- End Sub
- For Each FieldName In FieldNames ' assuming you have some looping construct here '
- strsql3 = "SELECT " & FieldName & " FROM table"
- On Error Resume Next
- Set rs3 = CurrentDb.OpenRecordset(strsql3)
- If Err.Number = 3061 Then
- ' Do nothing. We dont care about this error '
- Err.Clear
- Else
- MsgBox "Uncaught error number " & Err.Number & " (" & Err.Description & ")"
- Err.Clear
- End If
- On Error GoTo 0
- Next FieldName
- ...act on error, or simply ignore if necessary...
Add Comment
Please, Sign In to add comment