code_junkie

MS Access: How to bypass/suppress an error?

Nov 12th, 2011
54
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 5.35 KB | None | 0 0
  1. select field from table;
  2.  
  3. Option Explicit
  4.  
  5. Private Sub UpdateNulls()
  6. Dim rs2 As DAO.Recordset
  7. Dim tdf As DAO.TableDef
  8. Dim db As Database
  9. Dim varii As Variant, strField As String
  10. Dim strsql As String, strsql2 As String, strsql3 As String
  11. Dim astrFields As Variant
  12. Dim intIx As Integer
  13. Dim field As Variant
  14. Dim astrvalidcodes As Variant
  15. Dim found As Boolean
  16. Dim v As Variant
  17.  
  18.  
  19. Open "C:Documents and SettingsDesktoptestfile.txt" For Input As #1
  20. varii = ""
  21. Do While Not EOF(1)
  22. Line Input #1, strField
  23. varii = varii & "," & strField
  24. Loop
  25. Close #1
  26. astrFields = Split(varii, ",") 'Element 0 empty
  27.  
  28.  
  29.  
  30.  
  31. For intIx = 1 To UBound(astrFields)
  32.  
  33.  
  34. 'Function ListFieldDescriptions()
  35. Dim cn As New ADODB.Connection, cn2 As New ADODB.Connection
  36. Dim rs As ADODB.Recordset, rs3 As ADODB.Recordset
  37. Dim connString As String
  38. Dim SelectFieldName
  39.  
  40. Set cn = CurrentProject.Connection
  41.  
  42. SelectFieldName = astrFields(intIx)
  43.  
  44. Set rs = cn.OpenSchema(adSchemaColumns, Array(Empty, Empty, Empty, SelectFieldName))
  45.  
  46. 'Show the tables that have been selected '
  47. While Not rs.EOF
  48.  
  49. 'Exclude MS system tables '
  50. If Left(rs!Table_Name, 4) <> "MSys" Then
  51. strsql = "Select t.* From [" & rs!Table_Name & "] t Inner Join 01UMWELT On t.fall = [01UMWELT].fall Where [01UMWELT].Status = 4"
  52. End If
  53.  
  54. Set rs3 = CurrentDb.OpenRecordset(strsql)
  55.  
  56. 'End Function
  57.  
  58. strsql2 = "SELECT label.validcode FROM variablen s INNER JOIN label ON s.id=label.variablenid WHERE varname='" & astrFields(intIx) & "'"
  59.  
  60. Set db = OpenDatabase("C:Documents and SettingsDesktopCodebook.mdb")
  61. Set rs2 = db.OpenRecordset(strsql2)
  62.  
  63. With rs2
  64. .MoveLast
  65. .MoveFirst
  66. astrvalidcodes = rs2.GetRows(.RecordCount)
  67. .Close '
  68. End With
  69.  
  70.  
  71. With rs3
  72. .MoveFirst
  73. While Not rs3.EOF
  74. found = False
  75. For Each v In astrvalidcodes
  76. If v = .Fields(0) Then
  77. found = True
  78. Debug.Print .Fields(0)
  79. Debug.Print .Fields(1)
  80.  
  81.  
  82. Exit For
  83. End If
  84. Next
  85. If Not found Then
  86. msgbox "xxxxxxxxxxxxxxxx"
  87.  
  88. End If
  89. End If
  90. .MoveNext
  91.  
  92.  
  93. Wend
  94. End With
  95.  
  96. On Error GoTo 0 'End of special handling
  97.  
  98. Wend
  99.  
  100.  
  101.  
  102. Next intIx
  103.  
  104.  
  105. End Sub
  106.  
  107. Function ListTablesContainingField()
  108. Dim cn As New ADODB.Connection, cn2 As New ADODB.Connection
  109. Dim rs As ADODB.Recordset, rs2 As ADODB.Recordset
  110. Dim connString As String
  111. Dim SelectFieldName
  112.  
  113. Set cn = CurrentProject.Connection
  114.  
  115. SelectFieldName = "Fall" 'For tksy '
  116.  
  117. 'Get names of all tables that have a column called 'ID' '
  118. Set rs = cn.OpenSchema(adSchemaColumns, _
  119. Array(Empty, Empty, Empty, SelectFieldName))
  120.  
  121. 'Show the tables that have been selected '
  122. While Not rs.EOF
  123.  
  124. 'Exclude MS system tables '
  125. If Left(rs!Table_Name, 4) <> "MSys" Then
  126. ' Edit for tksy, who is using more than one forum '
  127. If tdf.Name = "01UMWELT" Then
  128. strSQL = "Select * From 01UMWELT Where Status = 5"
  129. Else
  130. strSQL = "Select a.* From [" & rs!Table_Name _
  131. & "] a Inner Join 01UMWELT On a.fall = 01UMWELT.fall " _
  132. & "Where 01UMWELT.Status = 5"
  133. End If
  134. Set rs2 = CurrentDb.OpenRecordset(strSQL)
  135.  
  136. Do While Not rs2.EOF
  137. For i = 0 To rs2.Fields.Count - 1
  138. If IsNull(rs2.Fields(i)) Then
  139. rs2.Edit
  140. rs2.Fields(i) = 111111
  141. rs2.Update
  142. End If
  143. Next
  144. rs2.MoveNext
  145. Loop
  146. End If
  147. rs.MoveNext
  148. Wend
  149. rs.Close
  150. Set cn = Nothing
  151.  
  152. End Function
  153.  
  154. Sub TableTest
  155. On Error Goto TableTest_Error
  156.  
  157. ' ...code that can fail... '
  158.  
  159. Exit Sub
  160.  
  161. :TableTest_Error
  162. If Err.Number = 3061 Then
  163. Err.Clear()
  164. DoSomething()
  165. Else
  166. MsgBox Err.Description ' or whatever you find appropriate '
  167. End If
  168. End Sub
  169.  
  170. Sub TableTest
  171. ' ... fail-safe code ... '
  172.  
  173. On Error Resume Next
  174. ' ...code that can fail... '
  175. If Err.Number = 3061 Then
  176. Err.Clear()
  177. DoSomething()
  178. Else
  179. MsgBox Err.Description
  180. End If
  181. On Error Goto 0
  182.  
  183. ' ...mode fail-safe code... '
  184. End Sub
  185.  
  186. For Each FieldName In FieldNames ' assuming you have some looping construct here '
  187.  
  188. strsql3 = "SELECT " & FieldName & " FROM table"
  189.  
  190. On Error Resume Next
  191. Set rs3 = CurrentDb.OpenRecordset(strsql3)
  192.  
  193. If Err.Number = 3061 Then
  194. ' Do nothing. We dont care about this error '
  195. Err.Clear
  196. Else
  197. MsgBox "Uncaught error number " & Err.Number & " (" & Err.Description & ")"
  198. Err.Clear
  199. End If
  200.  
  201. On Error GoTo 0
  202.  
  203. Next FieldName
  204.  
  205. ...act on error, or simply ignore if necessary...
Add Comment
Please, Sign In to add comment