[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 Row, Col, Rows, Cols, CurRow, CurCol
Dim iCnt, wCnt, wCnt_MemNfd
Dim sMapDate
' 初期 -------------------------------------------
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
'ジョブ名を入力し、更新区分が照会のみの時に実行する
If SetMap210JobnameGo(sJobNm) = False Then
Exit Do
End If
SetWaitTime(lmilliseconds) '待機する時間
'■2.画面「結果」から
'業務コードを取得しファイル出力
'画面の行数?列数を取得
Rows = emlECLPSObj.NumRows:Cols= emlECLPSObj.NumCols
'画面右上の現在に日付を取得して西暦4桁へ変換
sMapDate = GetMapCurDate
'効力有効な一覧情報を取得する
Dim sResJOBNm:sResJOBNm = ""
Dim sResGYOMU:sResGYOMU = ""
Dim sResValidS:sResValidS = ""
Dim sResValidE:sResValidE = ""
Dim iGYO:iGYO = 9
Dim iRTU:iRTU = 7
Dim iGYOMAX:iGYOMAX = 18
Dim iValidDay:iValidDay = 0
Do Until iValidDay = 1 Or _
emlECLPSObj.GetText(iGYO, iRTU, 8) = "" Or _
iGYO > iGYOMAX Or
IsMapMemExsist = True
sResJOBNm = 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 IsValidDate(sMapDate,sResValidS,sResValidE) = True
iValidDay = 1 '効力有効行の時
Exit Do
End If
iGYO = iGYO + 1
Loop
'
'■3.検索結果を含めて、効力判定に従いテキストファイル出力
Dim sRec
If iValidDay = 1 Then
sRec = "#" & sMapDate & "," & sJobNm & "," & _
sResJOBNm & "," & sResGYOMU & ",#" & sResValidS & ",#" & sResValidE
wCnt = wCnt + 1
Else
sRec = "#" & sMapDate & "," & sJobNm & "," & _
sResJOBNm & "," & sResGYOMU & "," & sResValidS & "," & sResValidE
wCnt_MemNfd = wCnt_MemNfd + 1
End If
file2.WriteLine(sRec)
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 IsMapMemExsist
Dim row:row = 24 '画面位置（行）
Dim col:col = 12 '画面位置（列）
Dim MemKey:MemKey = "対象レコードなし"
IsMapMemExsist = True
If emlECLPSObj.GetText(row, col, 16) = MemKey Then
IsMapMemExsist = False
End If
End Function
' 画面の現在日の取得 ---------------------------
Function GetMapCurDate
Dim row:row = 1 '画面位置（行）
Dim col:col = 63 '画面位置（列）
Dim sMapDate:sMapDate = ""
sMapDate = emlECLPSObj.GetText(row, col, 8)
sMapDate = "20" & sMapDate
If Mid(sMapDate,1,2) >= "70" Then
sMapDate = "19" & sMapDate
End If
End Function
' 画面の判定（開始画面）------------------------
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 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 IsValidDate(sMapDate,sYYS,sYYE)
Dim sYYYYS:sYYYYS = ""
Dim sYYYYE:sYYYYE = ""
IsValidDate = False
'２桁表示の西暦を４桁表示に変換
If sYYS <> "" Then
sYYYYS = "20" & sYYS
If Mid(sYYS,1,2) >= "70" Then
sYYYYS = "19" & sYYS
End If
End If
If sYYE <> "" Then
sYYYYE = "20" & sYYE
If Mid(sYYE,1,2) >= "70" Then
sYYYYE = "19" & sYYE
End If
End If
' 有効範囲の判定
If sMapDate >= sYYYYS And sMapDate <= sYYYYE Then
'効力有効の時
IsValidDate = True
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
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 Row, Col, Rows, Cols, CurRow, CurCol
Dim iCnt, wCnt, wCnt_MemNfd
Dim sMapDate
' 初期 -------------------------------------------
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
'ジョブ名を入力し、更新区分が照会のみの時に実行する
If SetMap210JobnameGo(sJobNm) = False Then
Exit Do
End If
SetWaitTime(lmilliseconds) '待機する時間
'■2.画面「結果」から
'業務コードを取得しファイル出力
'画面の行数?列数を取得
Rows = emlECLPSObj.NumRows:Cols= emlECLPSObj.NumCols
'画面右上の現在に日付を取得して西暦4桁へ変換
sMapDate = GetMapCurDate
'効力有効な一覧情報を取得する
Dim sResJOBNm:sResJOBNm = ""
Dim sResGYOMU:sResGYOMU = ""
Dim sResValidS:sResValidS = ""
Dim sResValidE:sResValidE = ""
Dim iGYO:iGYO = 9
Dim iRTU:iRTU = 7
Dim iGYOMAX:iGYOMAX = 18
Dim iValidDay:iValidDay = 0
Do Until iValidDay = 1 Or _
emlECLPSObj.GetText(iGYO, iRTU, 8) = "" Or _
iGYO > iGYOMAX Or
IsMapMemExsist = True
sResJOBNm = 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 IsValidDate(sMapDate,sResValidS,sResValidE) = True
iValidDay = 1 '効力有効行の時
Exit Do
End If
iGYO = iGYO + 1
Loop
'
'■3.検索結果を含めて、効力判定に従いテキストファイル出力
Dim sRec
If iValidDay = 1 Then
sRec = "#" & sMapDate & "," & sJobNm & "," & _
sResJOBNm & "," & sResGYOMU & ",#" & sResValidS & ",#" & sResValidE
wCnt = wCnt + 1
Else
sRec = "#" & sMapDate & "," & sJobNm & "," & _
sResJOBNm & "," & sResGYOMU & "," & sResValidS & "," & sResValidE
wCnt_MemNfd = wCnt_MemNfd + 1
End If
file2.WriteLine(sRec)
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 IsMapMemExsist
Dim row:row = 24 '画面位置（行）
Dim col:col = 12 '画面位置（列）
Dim MemKey:MemKey = "対象レコードなし"
IsMapMemExsist = True
If emlECLPSObj.GetText(row, col, 16) = MemKey Then
IsMapMemExsist = False
End If
End Function
' 画面の現在日の取得 ---------------------------
Function GetMapCurDate
Dim row:row = 1 '画面位置（行）
Dim col:col = 63 '画面位置（列）
Dim sMapDate:sMapDate = ""
sMapDate = emlECLPSObj.GetText(row, col, 8)
sMapDate = "20" & sMapDate
If Mid(sMapDate,1,2) >= "70" Then
sMapDate = "19" & sMapDate
End If
End Function
' 画面の判定（開始画面）------------------------
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 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 IsValidDate(sMapDate,sYYS,sYYE)
Dim sYYYYS:sYYYYS = ""
Dim sYYYYE:sYYYYE = ""
IsValidDate = False
'２桁表示の西暦を４桁表示に変換
If sYYS <> "" Then
sYYYYS = "20" & sYYS
If Mid(sYYS,1,2) >= "70" Then
sYYYYS = "19" & sYYS
End If
End If
If sYYE <> "" Then
sYYYYE = "20" & sYYE
If Mid(sYYE,1,2) >= "70" Then
sYYYYE = "19" & sYYE
End If
End If
' 有効範囲の判定
If sMapDate >= sYYYYS And sMapDate <= sYYYYE Then
'効力有効の時
IsValidDate = True
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
