[TCPLINK SCRIPT HEADER]
DESCRIPTION=Job GYOMU Code Information List(3270 Emulator)
[TCPLINK SCRIPT SOURCE]
'Option Explicit
' ***********************************************
' 機能:指定したJOBの業務コードを取得する
' 入力:マクロ名+_I.txt メンバ名を行列記する
' 出力:マクロ名+_0.CSV JOB名、業務名、有効開始 有効終了
' 変更履歴
' 2023.06.29 入力テキストに空行がある時は、処理対象としない
' 2023.06.30 検索一覧から効力期間に該当するレコードを出力する
' 2023.06.30 検索で該当なしの場合もレコードを出力する
' ***********************************************
Dim emlECLPSObj
Dim sThisSessionName, sThisMacroName
Dim sMsg
Dim sDsName, sDsName1
Dim Row, Col, Rows, Cols, CurRow, CurCol
Dim iCnt, wCnt, wCnt_MemNfd
Dim sMapDate, sResJOB, sResGYOMU, sResValidS, sResValidE
Dim bRC
Dim iGYO, iRTU
' 初期 -------------------------------------------
Dim G_Ver:G_Ver = " 1.1 "
Dim iDebug:iDebug = 0
Dim lmilliseconds:lmilliseconds = 3000
Dim lmilliseconds2:lmilliseconds2 = 1000
Dim BeginKey:BeginKey = "V1210"
' 共通プロパティー値の設定 -----------------------
sThisMacroName = Replace(GetCommonMacroname(),".mac","")
sThisSessionName = GetCommonSessionName()
Set emlECLPSObj = CreateObject("TESSC.emlECLPS")
emlECLPSObj.SetConnectionByName(sThisSessionName)
Dim sTitle:sTitle = sThisMacroName
Dim IFileNm:IFileNm = sThisMacroName & "_I.txt"
Dim OFileNm:OFileNm = sThisMacroName & "_O.CSV"
' 主処理 ----------------------------------------
If IsEnableEnv(sTitle) = False Then
MsgBox " ヘルスチェック：利用不可です",64,sTitle
Else
'処理開始画面の確認
If IsFirstMap(BeginKey) Then
'*メンバー数分の繰返し開始
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileEXISTS(IFileNm) = True Then
Set file1 = fso.OpenTextFile(".\" & IFileNm)
Set file2 = fso.OpenTextFile(".\" & OFileNm, 2, True)
sMsg = " 入力テキストファイル名：" & IFileNm & vbCrLf & _
" JOB名：" & " ******** " & vbCrLf & _
" 出力テキストファイル名：" & OFileNm
MyVar = MsgBox (sMsg, vbYesNo,sTitle & G_Ver)
If MyVar = vbYES Then
wCnt = 0:wCnt_MemNfd = 0
'入力テキストをレコード単位に読み込む
iCnt=0: sJobNm = ""
Do Until file1.AtEndOfStream
sJobNm = file1.readline
iCnt = iCnt + 1
'■1.J0B名を指定して実行
If sJobNm <> "" Then
'ジョブ名を入力し、更新区分が照会のみの時に実行する
bRC = SetMap210JobnameGo(sJobNm)
If bRC = False Then
Exit Do
End If
SetWaitTime(lmilliseconds) '待機する時間
'■2.画面「結果」から
'業務コードを取得しファイル出力
'画面の行数?列数を取得
Rows = emlECLPSObj.NumRows:Cols= emlECLPSObj.NumCols
'画面右上の現在に日付を取得して西暦4桁へ変換
' ++++++++++++++++++++++++++++++++++++++>>
sMapDate = emlECLPSObj.GetText(1,63,8)
sMapDate = "20" & sMapDate
If Mid(sMapDate,1,2) >= "70" Then
sMapDate = "19" & sMapDate
End If
' ++++++++++++++++++++++++++++++++++++++<<
' ++++++++++++++++++++++++++++++++++++++++
Dim sWTResValidS, sWTResValidE
'効力有効な一覧情報を取得する
iGYO= 9:iRTU = 7
sResJOB = "":sResGYOMU = "":sResValidS = "":sResValidE = ""
sWTResValidS = "":sWTResValidE = ""
Do Until emlECLPSObj.GetText(iGYO, iRTU, 8) = "" Or _
iGYO > 18 Or _
emlECLPSObj.GetText(24,12,16) = "対象レコードなし"
sResJOB = emlECLPSObj.GetText(iGYO,iRTU,8)
sResGYOMU = emlECLPSObj.GetText(iGYO,iRTU+10,8)
sResValidS = emlECLPSObj.GetText(iGYO,iRTU+20,8)
sResValidE = emlECLPSObj.GetText(iGYO,iRTU+30,8)
' +++++++++++>>
'２桁表示の西暦を４桁表示に変換して西暦年の範囲判定する
If sResValidS <> "" Then
sWTResValidS = "20" & sResValidS
If Mid(sResValidS,1,2) >= "70" Then
sWTResValidS = "19" & sResValidS
End If
End If
If sResValidE <> "" Then
sWTResValidE = "20" & sResValidE
If Mid(sResValidE,1,2) >= "70" Then
sWTResValidE = "19" & sResValidE
End If
End If
' +++++++++++<<
If sMapDate >= sWTResValidS And sMapDate <= sWTResValidE Then
'効力有効行の時
Exit Do
End If
iGYO = iGYO + 1
Loop
'
'■3.検索結果を含めて、効力判定に従いテキストファイル出力
' ++++++++++++++++++++++++++++++++++++++>>
If sResGYOMU <> "" Then
file2.WriteLine("#" & sMapDate & "," & sJobNm & "," & _
sResJOB & "," & sResGYOMU & ",#" & sResValidS & ",#" & sResValidE)
wCnt = wCnt + 1
Else
file2.WriteLine("#" & sMapDate & "," & sJobNm & "," & _
sResJOB & "," & sResGYOMU & "," & sResValidS & "," & sResValidE)
wCnt_MemNfd = wCnt_MemNfd + 1
End If
' ++++++++++++++++++++++++++++++++++++++<<
SetWaitTime(lmilliseconds2) '待機する時間
End If
Loop
' 終了 -----------------------------------
file1.Close:file2.Close
Set fso = Nothing
sMsg = " 処理終了 " & vbCrlf & _
" 入カテキストファイル名 " & IFileNm & vbCrlf & _
" 件数 ：" & iCnt & vbCrlf & _
" 出力テキストファイル名 " & OFileNm & vbCrlf & _
" 件数（正常） ：" & wCnt & vbCrlf & _
" 件数（メンバ無） ：" & wCnt_MemNfd
MsgBox sMsg, vbInformation, sTitle & G_Ver
Else
MsgBox " 処理続行に「いいえ」と応答した ",vbCritical,sTitle & G_Ver
End If
Else
MsgBox " 入力テキストファイルが存在なし " & IFileNm,vbCritical,sTitle & G_Ver
End If
Else
MsgBox " 開始画面が「V1210画面」ではない " ,vbCritical,sTitle & G_Ver
End If
End If
' ************************************************
' 関数
' ************************************************
' ------------------------------------------------
' 画面の判定（開始画面）
' ------------------------------------------------
Function IsFirstMap(BeginKey)
Dim row:row = 1 '画面位置（行）
Dim col:col = 2 '画面位置（列）
IsFirstMap = False
' 文字列の存在有無と判定
If emlECLPSObj.SearchText("V1210", 1, row, col) Then
IsFirstMap = True
End If
End Function
' 表示入力画面でDS指定して実行する ---------------
Function SetMap210JobnameGo(sJobName1)
Dim row:row = 4 '画面位置（行）
Dim col:col = 21 '画面位置（列）
Dim row1:row1 = 3 '画面位置（行）
Dim col1:col1 = 21 '画面位置（列）
Dim sDsName
Dim sKBN
SetMap210JobnameGo = False
'更新区分が照会のみしか実行させない
sKBN = emlECLPSObj.GetText(row,col,1)
If sKBN = "S" Then
sJobName = sJobName1 & "[enter]"
emlECLPSObj.SendKeys sJobName, row1, col1
SetMap210JobnameGo = True
MsgBox " 更新区分が照会以外は不可。" & sJobName1,vbCritical,sTitle & G_Ver
End If
End Function
' 指定時間、処理を待機する -----------------------
Function SetWaitTime(lmilliseconds)
emlECLPSObj.Wait(lmilliseconds)
End Function
' 共通プロパティの取得 --------------------------
Function GetCommonMacroname
GetCommonMacroname = ThisMacroName
End Function
Function GetCommonSessionName
GetCommonSessionName = ThisSessionName
End Function
' -----------------------------------------------------
' ヘルスチェック 利用可能判定
' -----------------------------------------------------
Function IsEnableEnv(sTitle)
Dim bStarted:bStarted = emlECLPSObj.Started '
Dim bCommStarted:bCommStarted = emlECLPSObj.CommStarted '
Dim bAPIEnabled:bAPIEnabled = emlECLPSObj.APIEnabled '
Dim bReady:bReady = emlECLPSObj.Ready '
'
IsEnableEnv = False
If (bStarted = True and _
bCommStarted = True and _
bAPIEnabled = True and _
bReady = True) Then
IsEnableEnv = True
Else
sMsg = " Started ：" & bStarted & vbCrlf & _
" CommStarted ：" & bCommStarted & vbCrlf & _
" APIEnabled ：" & bAPIEnabled & vbCrlf & _
" Ready ：" & bReady
Msgbox sMsg,64,sTitle
End If
End Function
