Word Macro that uses a comma delimited text file with DDE to write to a 5250 session

Return to Introduction


Sub EnterBillingNumbers()

' EnterBillingNumbers Macro
' Macro edit 08/31/00 by Colin Riley


' DDEScript Macro

' Macro created 08/15/00 by Colin Riley
Dim Item As String
Dim Topic As String
Dim ChanA As Variant
Dim Title As String
Dim TextFile As String
Dim ErrorFile As String
Dim BTN As String
Dim Warning As String
Dim ErrorMsg As String
Dim ErrorDesc As String
Dim CodeSection As Integer
Dim SameSERLC As String
Dim Company As String
Dim SERLC As String
Dim Account As String
Dim County As String
Dim City As String
Dim State As String
Dim Zipcode As String
DDETerminateAll
CodeSection = 0
Item = "IBM525032"
Topic = "SessionA"
On Error GoTo ErrHandle
TextFile = "C:/My Documents/SourceFiles/TestNumbersA.txt"
Open TextFile For Input As #1
ErrorFile = "C:/My Documents/SourceFiles/ErrorFile.txt"
Open ErrorFile For Output As #2
ChanA = DDEInitiate(Item, Topic)
' Open channel
MsgBox "Channel Number= " & ChanA, vbOKOnly, "Destination Channel"
Input #1, Account, SERLC, Company, County, City, State, Zipcode, BTN
'***************************************************************************
*******************
Do While Not EOF(1)

'Start from Service Order Header screen

Title = DDERequest(ChanA, "STRING" & "(" & "0101,1," & Chr(34) & " Service Order Header" & Chr(34) & ")")
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
MsgBox "Screen location" & Title, vbOKOnly
If Title <> "0109" Then
' If this Screen Title location is not returned then the session is on the wrong screen.
MsgBox "Please Start this script from the service order header screen",
vbOKOnly, "Error"
DDETerminate ChanA
Close #1
Close #2
Exit Sub
End If
 
DDEExecute ChanA, "[SENDKEY(pf9)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEExecute ChanA, "[SENDKEY(erase eof)]"

'Customer Search
********************************************************************

DDEPoke ChanA, "EPS" & "(1461,1)", "1"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEPoke ChanA, "SETCURSOR", "1468"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEExecute ChanA, "[SENDKEY(erase field)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
MsgBox "Account " & Account, vbOKOnly
DDEPoke ChanA, "EPS" & "(1468,1)", Account 'Write account number to field starting at 1468
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEExecute ChanA, "[SENDKEY(pf10)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"

'Consolidated Customer View
' *********************************************************

DDEPoke ChanA, "SETCURSOR", "801"
DDEExecute ChanA, "[SENDKEY(erase eof)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEExecute ChanA, "[SENDKEY(" & Chr(34) & "X" & Chr(34) & ")]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEExecute ChanA, "[SENDKEY(pf10)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"

' Service Location Selection
' ********************************************************

DDEPoke ChanA, "EPS" & "(0803,1)", SERLC
DDEExecute ChanA, "[SENDKEY(pf15)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
CodeSection = 1

'Verify that service location is present

Title = DDERequest(ChanA, "STRING" & "(" & "0101,1," & Chr(34) & SERLC &
Chr(34) & ")")
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
If Title = "None" Then
ErrorMsg = "Service Location not found"
GoTo ErrHandle
End If
DDEPoke ChanA, "SETCURSOR", "1041"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEExecute ChanA, "[SENDKEY(" & Chr(34) & "X" & Chr(34) & ")]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEExecute ChanA, "[SENDKEY(pf6)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"

'Service Category
' ***************************************************************

DDEPoke ChanA, "SETCURSOR", "1041"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEExecute ChanA, "[SENDKEY(" & Chr(34) & "X" & Chr(34) & ")]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEExecute ChanA, "[SENDKEY(pf6)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
'Wireline Service Type
' **********************************************************

DDEPoke ChanA, "SETCURSOR", "0961"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEExecute ChanA, "[SENDKEY(" & Chr(34) & "X" & Chr(34) & ")]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEExecute ChanA, "[SENDKEY(pf6)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEExecute ChanA, "[SENDKEY(pf9)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"

'Service Provider
' $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$

DDEExecute ChanA, "[SENDKEY(erase eof)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEPoke ChanA, "EPS" & "(0899,1)", "ONNET"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEExecute ChanA, "[SENDKEY(pf9)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
'Circuit ID
' %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

DDEExecute ChanA, "[SENDKEY(pf9)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
'Circuit Leg
'DDEExecute ChanA, "[SENDKEY(erase eof)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEPoke ChanA, "EPS" & "(1299,1)", State
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
 
 
DDEPoke ChanA, "EPS" & "(1346,1)", "B"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
MsgBox "Proceed", vbOKOnly
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEExecute ChanA, "[SENDKEY(pf9)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
MsgBox "Proceed", vbOKOnly
DDEExecute ChanA, "[SENDKEY(erase eof)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEPoke ChanA, "EPS" & "(1059,1)", Company
MsgBox "Proceed", vbOKOnly
DDEExecute ChanA, "[SENDKEY(pf4)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEExecute ChanA, "[SENDKEY(erase eof)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEPoke ChanA, "EPS" & "(1370,1)", County
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEExecute ChanA, "[SENDKEY(erase eof)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEPoke ChanA, "EPS" & "(1409,1)", City
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEExecute ChanA, "[SENDKEY(erase eof)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEPoke ChanA, "EPS" & "(1459,1)", State
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEExecute ChanA, "[SENDKEY(erase eof)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEPoke ChanA, "EPS" & "(1479,1)", Zipcode
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEPoke ChanA, "SETCURSOR", "1516"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEExecute ChanA, "[SENDKEY(" & Chr(34) & "USA" & Chr(34) & ")]"
DDEPoke ChanA, "SETCURSOR", "1539"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEExecute ChanA, "[SENDKEY(" & Chr(34) & "US" & Chr(34) & ")]"
MsgBox "Proceed", vbOKOnly
DDEExecute ChanA, "[SENDKEY(pf9)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"

'Dedicated Sub-Classification
************************************************

DDEPoke ChanA, "EPS" & "(0803,1)", "DDID"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEExecute ChanA, "[SENDKEY(pf15)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEExecute ChanA, "[SENDKEY(tab field)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEExecute ChanA, "[SENDKEY(" & Chr(34) & "X" & Chr(34) & ")]"
DDEExecute ChanA, "[SENDKEY(pf9)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEExecute ChanA, "[SENDKEY(erase eof)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEPoke ChanA, "EPS" & "(0899,1)", "ONNET"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
'DDEExecute ChanA, "[SENDKEY(pf9)]"
'DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
SameSERLC = SERLC
 
Do While SameSERLC = SERLC And Not EOF(1)
AddNumber:
CodeSection = 2
DDEExecute ChanA, "[SENDKEY(pf9)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
'DDEExecute ChanA, "[SENDKEY(tab field)]"
DDEExecute ChanA, "[SENDKEY(erase eof)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEPoke ChanA, "EPS" & "(0905,1)", BTN ' Attempt to add guide point
DDEExecute ChanA, "[SENDKEY(pf4)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
Warning = DDERequest(ChanA, "STRING" & "(" & "1841,1," & Chr(34) & "Guiding Number not available" & Chr(34) & ")")
If Warning <> "None" Then
ErrorMsg = "Guiding Number not available"
GoTo ErrHandle
End If
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEExecute ChanA, "[SENDKEY(pf4)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEExecute ChanA, "[SENDKEY(" & Chr(34) & "N" & Chr(34) & ")]"
DDEExecute ChanA, "[SENDKEY(pf9)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
Input #1, Account, SERLC, Company, County, City, State, Zipcode, BTN
If SERLC <> SameSERLC Then Exit Do
'***************************************************************************
Loop
' Inner loop to add guide point
FirmOrder: '
DDEExecute ChanA, "[SENDKEY(pf3)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEExecute ChanA, "[SENDKEY(pf3)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEExecute ChanA, "[SENDKEY(pf12)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEExecute ChanA, "[SENDKEY(pf12)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEExecute ChanA, "[SENDKEY(" & Chr(34) & "4" & Chr(34) & ")]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEExecute ChanA, "[SENDKEY(pf9)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"

' NEW LINe -------------------------------------------

NewLine:
If EOF(1) Then Exit Do
 
'***************************************************************************
******************
Loop
Close #1
Close #2
DDETerminate ChanA
MsgBox "I am finished", vbOKOnly
Exit Sub
ErrHandle:
ErrorMsg = DDERequest(ChanA, "EPS(1841,40,1)")
ErrorDesc = Err.Description
Write #2, BTN, Account, SERLC, ErrorDesc, ErrorMsg
MsgBox "ErrorMessage is " & ErrorMsg, vbOKOnly
Select Case CodeSection
Case 1
'Service location not found
DDEExecute ChanA, "[SENDKEY(pf12)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEExecute ChanA, "[SENDKEY(pf12)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
GoTo NewLine
'Return to service order header screen and get new record
Case 2
'Guide number not available navigate to start point and get next number
DDEExecute ChanA, "[SENDKEY(reset)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEExecute ChanA, "[SENDKEY(erase eof)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
DDEExecute ChanA, "[SENDKEY(pf12)]"
DDEExecute ChanA, "[SENDKEY(wait inp inh)]"
Input #1, Account, SERLC, Company, County, City, State, Zipcode, BTN
If EOF(1) Then GoTo FirmOrder
GoTo AddNumber
End Select
End Sub

Hosted by www.Geocities.ws

1