ここからいよいよ本当のツールとして利用できるようにご紹介いたします。
１．前提作業
まずは「サーバー管理台帳」と「実機環境作業手続き申請書」が必要となります。
①HTAを起動させるツールのOS
こちらは基本に「Windows 10」「Windows 11」のいずれかなら動くと思います。
②サーバー管理台帳のファイル：
見出しの行が3行目となり、データ情報は「4行目」から「41行目」までとなります。
ファイルの保存の前に「2025/12/20」の日付でフィルタをかけておいてください。
③実機環境作業手続き申請書のファイル：
基本的には「改訂履歴」(１番目)はシートだけを用意しておいてもらえればよいのですが、コードを検証して頂くには「作業手続き申請書」(２番目)のシートが存在した状態で正しい列の状態に揃えてもらわないと正しい動作にはならないのでご注意ください。
２．前回と今回の大きな違いは
単なるVBScriptとして終わらせず、HTMLと組み合わせHTAとしてツールを使えるようになったことです。HTMLとは若干違うのでコードとしての特徴が難しいところもありますが、基本的には
組合すととても便利になります。
３．今回の追加機能について
画面のイメージとしては以下になり、よりカスタマイズしやすくなったのかなと思います。
①フォルダのパスと参照先のパスと出力先のパスの入力項目のテーブルの配置
②申請日と作業実施日とサーバーIDとサーバー名と実行ボタンのテーブルの配置
③実行結果のテーブルの配置
４．注意点について
もしかするといきなり実行用しても反応がない可能性もあるのでブロック単位で実行確認してもらえると最終的に全部使えるようになるかもしれないので動かなかったときはそのように試してみてください。
５．今回の課題ついて
ウィンドウのサイズや見た目などの部分を次回に対応していきたいと思います。
<!DOCTYPE html>
<html>
<head>
<meta charset="UTF-8">
<HTA:APPLICATION
ID="App"
APPLICATIONNAME="実機環境作業手続き申請書"
BORDER="dialog"
CAPTION="yes"
SCROLL="no"
SINGLEINSTANCE="yes"
/>
<title>実機環境作業手続き申請書</title>
<style>
body {
font-family: Meiryo, MS Gothic;
font-size: 12px;
margin: 10px;
}
h2 {
text-align: center;
margin-bottom: 15px;
}
table {
border-collapse: collapse;
width: 900px;
}
th, td {
border: 1px solid #000;
padding: 4px;
}
input[type="text"] {
width: 95%;
}
</style>
<script language="VBScript">
Option Explicit
Sub ExecMain()
'======================================================================================
' 変数の設定
'======================================================================================
Dim basePath, srcPath, outPath
Dim xlApp, srcBook, srcSheet, outBook, outSheet
Dim setDateStr, shinseiUser, shinseiName2, workStartDate, workEndDate
Dim rawText, onlyNum, ch, idx
Dim NodeID, NodeName
Dim targetDate, dataStartRow, lastRow, outRow, r, hitcount
Dim targetText, i
Dim startCopyRow, pasteRow, copyRange, pasteRange, j, arr(5)
'======================================================================================
' 流用できる情報
'======================================================================================
'setDateStr = "2025/12/01" ' ← 文字列として保持
'shinseiUser = "藤巻正太郎"
'workStartDate = "2025/12/20"
setDateStr = Document.getElementById("setDateStr").Value
shinseiUser = Document.getElementById("shinseiUser").Value
shinseiName2 = Mid(shinseiUser, 1, 2)
workStartDate = Document.getElementById("workStartDate").Value
workEndDate = workStartDate
' サンプルコードのための動作確認のためフィルタリングの日付を「2025/12/25」を固定化
targetDate = workStartDate
'======================================================================================
' 参照元と出力先のファイルの指定してファイルを開く
'======================================================================================
basePath = Document.getElementById("basePath").Value
srcPath = Document.getElementById("srcPath").Value
outPath = Document.getElementById("outPath").Value
If basePath = "" Or srcPath = "" Or outPath = "" Or setDateStr = "" Or shinseiUser = "" Or workStartDate = "" Then
MsgBox "未入力の項目があります。すべて入力してください。"
window.close
else
srcPath = basePath & "\" & srcPath
outPath = basePath & "\" & outPath
End If
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False
xlApp.DisplayAlerts = False
Set srcBook = xlApp.Workbooks.Open(srcPath)
Set srcSheet = srcBook.Sheets(1)
Set outBook = xlApp.Workbooks.Open(outPath)
'======================================================================================
' 表紙の処理
'======================================================================================
Set outSheet = outBook.Sheets(1)
' 4列目（D列）7～10行に格納
outSheet.Cells(7, 4).Value = setDateStr
outSheet.Cells(8, 4).Value = shinseiUser
outSheet.Cells(9, 4).Value = workStartDate
outSheet.Cells(10, 4).Value = workEndDate
outSheet.Cells(14, 4).Value = workStartDate
outSheet.Cells(15, 4).Value = workEndDate
' 左寄せ（D7～D10）
outSheet.Range("D7:D10").HorizontalAlignment = -4131
outSheet.Range("D13:D15").HorizontalAlignment = -4131
'======================================================================================
' 改定履歴の処理
'======================================================================================
Set outSheet = outBook.Sheets(2)
' 4行目・2列目（B4）に文字列をセット
outSheet.Cells(4, 2).Value = setDateStr
outSheet.Cells(4, 4).Value = setDateStr
outSheet.Cells(4, 5).Value = shinseiName2
outSheet.Cells(4, 6).Value = setDateStr
' 中央揃え
outSheet.Cells(4, 2).HorizontalAlignment = -4108
outSheet.Cells(4, 4).HorizontalAlignment = -4108
outSheet.Cells(4, 6).HorizontalAlignment = -4108
'======================================================================================
'「作業手続き申請書」(シート名)でオートフィルタの設定を確認する
'======================================================================================
'「作業手続き申請書」(シート名)を指定する
Set outSheet = outBook.Sheets(3)
Const xlCellTypeVisible = 12
Const xlUp = -4162
dataStartRow = 4
If srcSheet.AutoFilterMode = False Then
MsgBox "オートフィルタが設定されていません。"
srcBook.Close False
outBook.Close False
xlApp.Quit
WScript.Quit
End If
MsgBox targetDate
srcSheet.Range("A4").AutoFilter 7, "*" & targetDate & "*"
On Error Resume Next
srcSheet.Range("G4:G41").SpecialCells xlCellTypeVisible
If Err.Number <> 0 Then
MsgBox "対象日付のデータがありません。"
Err.Clear
srcBook.Close False
outBook.Close False
xlApp.Quit
WScript.Quit
End If
On Error GoTo 0
lastRow = srcSheet.Cells(srcSheet.Rows.Count, "G").End(xlUp).Row
'======================================================================================
' 参照元ファイルのC列から出力先ファイルのH列に出力する処理
'======================================================================================
hitcount = 0
outRow = 28
For r = dataStartRow To lastRow
MsgBox r
If srcSheet.Rows(r).Hidden = False Then
If Trim(srcSheet.Cells(r, "G").Value) <> "" Then
NodeID = srcSheet.Cells(r, "C").Value
NodeName = srcSheet.Cells(r, "C").Value
'H列にサーバー管理番号を出力
outSheet.Cells(outRow, "H").Value = NodeID
'M列にサーバー名を出力
outSheet.Cells(outRow, "M").Value = NodeName
' R結合セルの書式を「数値」にする（VBScript）
With outSheet.Cells(outRow, "R")
If .MergeCells = True Then
.NumberFormat = "0"
End If
End With
' HTAに出力
Call AddResultRow(setDateStr, workStartDate, NodeID, NodeName)
'X列に「作業実施日/開始時間」を出力
rawText = CStr(srcSheet.Cells(r, "G").Value)
onlyNum = ""
For idx = 1 To Len(rawText)
ch = Mid(rawText, idx, 1)
If ch >= "0" And ch <= "9" Then
onlyNum = onlyNum & ch
End If
Next
' YYYYMMDD の先頭8桁だけ使用
outSheet.Cells(outRow, "R").Value = Left(onlyNum, 8)
outSheet.Cells(outRow+1, "R").Value = "9時00分"
outRow = outRow + 2
hitcount = hitcount + 1
End If
End If
Next
'======================================================================================
' 参照元ファイルのD列から出力先ファイルのH列に出力処理（C列の続き）
'======================================================================================
For r = dataStartRow To lastRow
If srcSheet.Rows(r).Hidden = False Then
If Trim(srcSheet.Cells(r, "G").Value) <> "" Then
NodeID = srcSheet.Cells(r, "D").Value
NodeName = srcSheet.Cells(r, "D").Value
'H列にサーバー管理番号を出力
outSheet.Cells(outRow, "H").Value = NodeID
'M列にサーバー名を出力
outSheet.Cells(outRow, "M").Value = NodeName
' R結合セルの書式を「数値」にする（VBScript）
With outSheet.Cells(outRow, "X")
If .MergeCells = True Then
.NumberFormat = "0"
End If
End With
' HTAに出力
Call AddResultRow(setDateStr, workStartDate, NodeID, NodeName)
'X列に「作業実施日/終了時間」を出力
rawText = CStr(srcSheet.Cells(r, "G").Value)
onlyNum = ""
For idx = 1 To Len(rawText)
ch = Mid(rawText, idx, 1)
If ch >= "0" And ch <= "9" Then
onlyNum = onlyNum & ch
End If
Next
' YYYYMMDD の先頭8桁だけ使用
outSheet.Cells(outRow, "X").Value = Left(onlyNum, 8)
outSheet.Cells(outRow+1, "X").Value = "15時00分"
outRow = outRow + 2
hitcount = hitcount + 1
End If
End If
Next
MsgBox "対象日付 " & targetDate & " は " & hitcount & " 件です。"
'======================================================================================
' コピーして挿入する行の処理
'======================================================================================
targetText = "１．現在設定されている監視対象となっている"
lastRow = outSheet.Cells(outSheet.Rows.Count, "D").End(xlUp).Row
For r = 83 To lastRow
If InStr(outSheet.Cells(r, "D").Value, targetText) > 0 Then
startCopyRow = r
Exit For
End If
Next
hitcount = hitcount / 2 ' 整数除算（小数切り捨て）
For i = 1 To 7
Select Case i
Case 1
startCopyRow = startCopyRow + 2
MsgBox "挿入する行" & hitcount & "行分です"
MsgBox "最初の行の挿入開始位置は" & startCopyRow & "行目です"
arr(i-1) = startCopyRow
Case 2
startCopyRow = startCopyRow + pasteRow + 8
MsgBox "次の行の挿入開始位置は" & startCopyRow & "行目です"
arr(i-1) = startCopyRow
Case 3
startCopyRow = startCopyRow + 4
MsgBox "次の行の挿入開始位置は" & startCopyRow & "行目です"
arr(i-1) = startCopyRow
Case 5
startCopyRow = startCopyRow + 10
MsgBox "次の行の挿入開始位置は" & startCopyRow & "行目です"
arr(i-2) = startCopyRow
Case 6
startCopyRow = startCopyRow + 8
MsgBox "次の行の挿入開始位置は" & startCopyRow & "行目です"
arr(i-2) = startCopyRow
Case 7
startCopyRow = startCopyRow + 4
MsgBox "次の行の挿入開始位置は" & startCopyRow & "行目です"
arr(i-2) = startCopyRow
Case Else
startCopyRow = startCopyRow - pasteRow
MsgBox "次は切戻しの場合の設定値の行に移動します"
End Select
If i <> 4 Then
For j = 1 To hitcount - 1
outSheet.Rows(startCopyRow).Insert
startCopyRow = startCopyRow + 1
Next
MsgBox "最終行" & startCopyRow & "行です"
End If
Next
'======================================================================================
' 取得データを出力
'======================================================================================
For i = 1 To 7
Select Case i
Case 1
startCopyRow = arr(i-1)
MsgBox "最初の行の追記の開始位置は" & startCopyRow & "行目です"
For r = dataStartRow To lastRow
If srcSheet.Rows(r).Hidden = False Then
If Trim(srcSheet.Cells(r, "G").Value) <> "" Then
outSheet.Cells(startCopyRow, "E").Value = "□"
outSheet.Cells(startCopyRow, "E").HorizontalAlignment = -4108
outSheet.Cells(startCopyRow, "F").Value = srcSheet.Cells(r, "C").Value
outSheet.Cells(startCopyRow, "K").Value = srcSheet.Cells(r, "C").Value
startCopyRow = startCopyRow + 1
hitcount = hitcount + 1
End If
End If
Next
Case 2
startCopyRow = arr(i-1)
MsgBox "最初の行の追記の開始位置は" & startCopyRow & "行目です"
For r = dataStartRow To lastRow
If srcSheet.Rows(r).Hidden = False Then
If Trim(srcSheet.Cells(r, "G").Value) <> "" Then
outSheet.Cells(startCopyRow, "E").Value = "□"
outSheet.Cells(startCopyRow, "E").HorizontalAlignment = -4108
outSheet.Cells(startCopyRow, "F").Value = srcSheet.Cells(r, "D").Value
outSheet.Cells(startCopyRow, "K").Value = srcSheet.Cells(r, "D").Value
startCopyRow = startCopyRow + 1
hitcount = hitcount + 1
End If
End If
Next
Case 3
startCopyRow = arr(i-1)
MsgBox "最初の行の追記の開始位置は" & startCopyRow & "行目です"
For r = dataStartRow To lastRow
If srcSheet.Rows(r).Hidden = False Then
If Trim(srcSheet.Cells(r, "G").Value) <> "" Then
outSheet.Cells(startCopyRow, "E").Value = "□"
outSheet.Cells(startCopyRow, "E").HorizontalAlignment = -4108
outSheet.Cells(startCopyRow, "F").Value = srcSheet.Cells(r, "D").Value
outSheet.Cells(startCopyRow, "K").Value = srcSheet.Cells(r, "D").Value
startCopyRow = startCopyRow + 1
hitcount = hitcount + 1
End If
End If
Next
Case 5
startCopyRow = arr(i-2)
MsgBox "最初の行の追記の開始位置は" & startCopyRow & "行目です"
For r = dataStartRow To lastRow
If srcSheet.Rows(r).Hidden = False Then
If Trim(srcSheet.Cells(r, "G").Value) <> "" Then
outSheet.Cells(startCopyRow, "E").Value = "□"
outSheet.Cells(startCopyRow, "E").HorizontalAlignment = -4108
outSheet.Cells(startCopyRow, "F").Value = srcSheet.Cells(r, "D").Value
outSheet.Cells(startCopyRow, "K").Value = srcSheet.Cells(r, "D").Value
startCopyRow = startCopyRow + 1
hitcount = hitcount + 1
End If
End If
Next
Case 6
startCopyRow = arr(i-2)
MsgBox "最初の行の追記の開始位置は" & startCopyRow & "行目です"
For r = dataStartRow To lastRow
If srcSheet.Rows(r).Hidden = False Then
If Trim(srcSheet.Cells(r, "G").Value) <> "" Then
outSheet.Cells(startCopyRow, "E").Value = "□"
outSheet.Cells(startCopyRow, "E").HorizontalAlignment = -4108
outSheet.Cells(startCopyRow, "F").Value = srcSheet.Cells(r, "C").Value
outSheet.Cells(startCopyRow, "K").Value = srcSheet.Cells(r, "C").Value
startCopyRow = startCopyRow + 1
hitcount = hitcount + 1
End If
End If
Next
Case 7
startCopyRow = arr(i-2)
MsgBox "最初の行の追記の開始位置は" & startCopyRow & "行目です"
For r = dataStartRow To lastRow
If srcSheet.Rows(r).Hidden = False Then
If Trim(srcSheet.Cells(r, "G").Value) <> "" Then
outSheet.Cells(startCopyRow, "E").Value = "□"
outSheet.Cells(startCopyRow, "E").HorizontalAlignment = -4108
outSheet.Cells(startCopyRow, "F").Value = srcSheet.Cells(r, "C").Value
outSheet.Cells(startCopyRow, "K").Value = srcSheet.Cells(r, "C").Value
startCopyRow = startCopyRow + 1
hitcount = hitcount + 1
End If
End If
Next
End Select
Next
'======================================================================================
' Excel保存
'======================================================================================
srcBook.Close False
outBook.Save
outBook.Close
xlApp.Quit
MsgBox "実行完了"
End Sub
Sub AddResultRow(appDate, workDate, serverID, serverName)
Dim tbl, newRow
Set tbl = Document.getElementById("resultTable")
Set newRow = tbl.insertRow(tbl.rows.length)
newRow.insertCell(0).innerText = appDate
newRow.insertCell(1).innerText = workDate
newRow.insertCell(2).innerText = serverID
newRow.insertCell(3).innerText = serverName
End Sub
</script>
</head>
<body>
<h2>実機環境作業手続き申請書</h2>
<!-- ===== 説明１ ===== -->
１．以下のフォルダ名のパスとファイル名と作業実施日をご記入ください。
<br><br>
<table>
<tr>
<th width="45%">フォルダ名</th>
<th width="25%">参照元ファイル名</th>
<th width="30%">出力先ファイル名</th>
</tr>
<tr>
<td><input type="text" id="basePath"></td>
<td><input type="text" id="srcPath"></td>
<td><input type="text" id="outPath"></td>
</tr>
</table>
<br><br>
<!-- ===== 説明２ ===== -->
２．作業申請日と作業実施日担当者名をご記入して[データ出力]をクリックして下さい
<br><br>
<table>
<tr>
<th width="25%">作業申請日</th>
<th width="25%">作業実施日</th>
<th width="30%">作業担当者</th>
<th width="20%">申請書作成</th>
</tr>
<tr>
<td><input type="text" id="setDateStr"></td>
<td><input type="text" id="workStartDate"></td>
<td><input type="text" id="shinseiUser"></td>
<td style="text-align:center;">
<input type="button" value="データ出力" id="ExecMain" onclick="ExecMain()">
</td>
</tr>
</table>
<br><br>
<!-- ===== 実行結果 ===== -->
＜実行結果＞
<br><br>
<table id="resultTable">
<tr>
<th style="width:20%;">作業申請日</th>
<th style="width:20%;">作業実施日</th>
<th style="width:30%;">サーバーID</th>
<th style="width:30%;">サーバー名</th>
</tr>
</table>
</body>
</html>