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.
