Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations bkrike on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Error trapping in a loop

Status
Not open for further replies.
Nov 7, 2002
61
US
I'm running a script to our company's system using Access and VBA. Due to human error in the data I'm working with, some errors will result in the data not being inputted to the system (invalid file #'s).

I've written the loop and the error handling and created a table to store the data that errors out, but don't know how to write that data to the table as Access runs through the loop.

Any help would be greatly appreciated.

Thanks,
Mike
 
Any chance you could post the code you already have so far ?

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886
 
Option Compare Database
Dim idxSCN As Long
Dim idxCNN As Long
Dim idxMSG As Integer
Dim rsCNN As ADODB.Recordset
Dim iCount As Integer
Const Send = "Send"
Const Title = "Prospect Medical"
Const Enter = vbCrLf

Public Sub establishConnection()
Do Until idxCNN >= 1
If idxSCN >= 1 And idxCNN >= 1 Then Exit Do
idxCNN = DDEInitiate("IDXTERM", "Message") ' Establish DDE Message Connection to send info to IDX
idxSCN = DDEInitiate("IDXTERM", "Screen") ' Establish DDE Screen Connection to receive info from IDX
Loop
End Sub

Private Sub Command67_Click()

Dim oMember As String
Dim iCounter As Double
Dim rst As Recordset

'Set rst = CurrentDb.OpenRecordset("VendorAdd", dbopendynaset)
Dim Status As String
On Error Resume Next
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
On Error GoTo 0
CreateDataLink
CreateIDXLink
End Sub

Private Sub CreateDataLink(Optional Table_Or_Query_Name As String, _
Optional NoDataSource As Boolean)
If NoDataSource = True Then Exit Sub
Table_Or_Query_Name = "SCRIPTALL_SS"
If Table_Or_Query_Name = "" Then
Table_Or_Query_Name = InputBox("Please Provide the name of the table/query " _
& "your data will be pulled from:", _
"SCRIPTALL_SS", CurrentData.AllTables(2).Name)
End If

Set rsCNN = New ADODB.Recordset
rsCNN.CursorType = adOpenStatic
rsCNN.CursorLocation = adUseServer

rsCNN.Open Table_Or_Query_Name, _
CurrentProject.Connection, _
adOpenStatic, adLockReadOnly
End Sub


Private Function IDXSpecificLocation(RowNumber As String, _
ColumnNumber As String, _
LineNumber As String) As String
' Reads a specific area of the screen on IDX

' Variable Declaration
Dim strSearch As String

' Each number must be 2 digits
' A 0 is added before each number if only 1 digit (1-9)
If Len(RowNumber) < 2 Then RowNumber = "0" & RowNumber
If Len(ColumnNumber) < 2 Then ColumnNumber = "0" & ColumnNumber
If Len(LineNumber) < 2 Then LineNumber = "0" & LineNumber

' Build Search String
strSearch = "R" & RowNumber & "C" & ColumnNumber & "L" & LineNumber

' Obtain info from IDX
IDXSpecificLocation = Trim(DDERequest(idxSCN, "Piece"))

End Function

Private Function LocateCursor() As String
' Returns the current location of the cursor in Row;Column format

LocateCursor = DDERequest(idxSCN, "Cursor")
End Function

Private Function LeftLine() As String
' Reads *all* text to the *left* of the cursor
establishConnection
LeftLine = Trim(DDERequest(idxSCN, "LeftLine"))
End Function

Private Function RightLine() As String
' Reads *all* text to the *Right* of the cursor

RightLine = Trim(DDERequest(idxSCN, "RightLine"))
End Function

Private Function IDXLine() As String
' Reads *all* text on the line the cursor *currently* resides
IDXLine = Trim(DDERequest(idxSCN, "Line"))
End Function

Private Sub IDXWrite(TextToWrite As String, _
FieldName As Boolean, _
IncludeCarriageReturn As Boolean)
' Writes data to IDX based on field from data source or provided text
If FieldName = False Then
DDEPoke idxCNN, Send, TextToWrite
ElseIf FieldName = True Then
DDEPoke idxCNN, Send, rsCNN.Fields(TextToWrite)
End If
If IncludeCarriageReturn = True Then
DDEPoke idxCNN, Send, Enter
End If
End Sub

Private Sub buttonF10_Click()
establishConnection
F10
End Sub

Private Sub WriteEnter()
establishConnection
DDEPoke idxCNN, Send, Enter ' Send Carriage Return
End Sub

Private Sub SendTab()
establishConnection
DDEPoke idxCNN, Send, Chr(9) ' Send Tab Key
End Sub

Private Sub Pause(Optional Seconds As Double)
Dim intDiff As Double
intDiff = 0
If Seconds = 0 Then Seconds = 0.025
While intDiff <= Seconds
intDiff = intDiff + 0.0000001
Wend
End Sub

Private Sub Pause2(Optional Seconds As Double)
Dim intDiff As Double
intDiff = 0
If Seconds = 0 Then Seconds = 6.01
While intDiff <= Seconds
intDiff = intDiff + 0.0000001
Wend
End Sub

Private Sub CloseConnections()
On Error Resume Next
rsCNN.Close
DDETerminateAll
End Sub

'Private Sub Form_Open(Cancel As Integer)
'DoCmd.GoToRecord , , acNewRec
'End Sub

Private Sub buttonClear1_Click()
ClearForm1
End Sub

Private Sub buttonF7Q_Click()
establishConnection
DDEPoke idxCNN, Send, Chr(27) & "[18~" & "Q" ' F7 and Q
End Sub

Private Sub F7()
establishConnection
DDEPoke idxCNN, Send, Chr(27) & "[18~" ' F7
End Sub


Private Sub Next_Click()
On Error GoTo Err_Command68_Click
establishConnection
CreateDataLink
rsCNN.MoveNext

Exit_Command68_Click:
Exit Sub

Err_Command68_Click:
MsgBox Err.Description
Resume Exit_Command68_Click

End Sub

Private Sub Command69_Click()
On Error GoTo Err_Command69_Click
establishConnection
CreateDataLink
DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 6, , acMenuVer70

Exit_Command69_Click:
Exit Sub

Err_Command69_Click:
MsgBox Err.Description
Resume Exit_Command69_Click

End Sub

Private Sub Command70_Click()
establishConnection
F10
F10
rsCNN.MoveNext
End Sub

Public Sub IDXScript()
iCount = 0
Status = ""
On Error GoTo IDXScript_Err

Do While Not rsCNN.EOF
IDXWrite "CS", False, False
IDXWrite "CSRNUM", True, False
Pause
WriteEnter
IDXWrite "CSRVAL", True, False
WriteEnter
IDXWrite "CSRNAME", True, False
WriteEnter
IDXWrite "CSRDESC", True, False
WriteEnter
IDXWrite "CSRDT", True, False
WriteEnter
F10
F10
IDXWrite "INFO", False, False
WriteEnter
IDXWrite "CLS", False, False
F10
Pause2
‘iCount = iCount + 1
rsCNN.MoveNext
Loop
DoCmd.SetWarnings (False)
End Sub

Private Sub RunScript_Click()
establishConnection
CreateDataLink
IDXScript
End Sub
'-----------------------------------


The table is called "tblCSR" and has columns titled "VAL","NAME","DT" and "DESC". Each time the program loops through and is not able to input "VAL", I need to record the above four fields in the table.

Thanks.
 
VAL and DESC are RESERVED words.
So the field names should be [VAL] and [DESC]

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886
 
I changed the field names to VALUE and DESCR, but still need to know how to write to those fields from the loop.

Thanks.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top