'---------------------------------------------------------------------------------------------------
'
'使用方法：cscript PrintExcel [-html] Htmlファイル名 [-printer プリンタ名 -pdf PDFファイル名 ]
'								[-syslog ｼｽﾃﾑログ名 -joblog Jobログ名 -jobmask Jobログﾏｽｸ]
'								[-dpi 印刷品質 -org 大元のHtmlファイル名(例：TEST)]
'								[-aopt 附加オプション(3:複数要求NOのHTMLファイルを合併する、6:認証する雛型)]
'
'			2003年01月22日新規
'			プリンタ名---------> xls			Excelのファイル出力
'					|----------> プリンタ名 	プリンタ出力
'			PDFファイル名------> xxxxx\ 		Htmlファイル名ごとにファイル一つずつ出力
'					|----------> xxxxx\xxxxx	ファイル合併してこのファイル名で出力する
'			大元のHtmlファイル名 htm或いはhtmlの拡張子を付けないままのファイル名
'			EXCEL の表示を行うかどうかは、excelObj.Visible = True に設定します。
'---------------------------------------------------------------------------------------------------

Option Explicit

Const cnSysMsgFilter		= 6 		'ログﾏｽｸ
'Const cnSysMsgFilter			= &HFFFF	'ログﾏｽｸ
Const cnDefaultJobMsgFilter 	= 6 		'Jobごとのファイルログﾏｽｸ
Const cnDefaultScreenMsgFilter	= 6 		'画面出力ログﾏｽｸ
'Const cnDefaultScreenMsgFilter = &HFFFF	'画面出力ログﾏｽｸ

Const cnDescription = 1 		'説明
Const cnWarning 	= 2 		'ワーニング
Const cnError		= 4 		'エラー

Const csDescription = " INFO    [0]:"
Const csWarning 	= " WARNING [1]:"
Const csError		= " ERROR   [2]:"
Const csProgErr 	= " PG BUG  [3]:"

Const csPathSep 	= "\"       'ディレクトリの分かれ目
Const csExtSep		= "."
Const csEmptyString = ""		'空の文字列

Const cnLogFileMaxSize	= 5000000				' Log ファイルの最大値 およそ5M

Const ccMultiYkno		= "3"	'同じディレクトリに複数要求NOのHTMLファイルを合併する
Const ccOrgCertified	= "6"	'雛型が認証したもの

'PDF995に対応
Const csPDF995DefaultIniPath	= "C:\pdf995\res"
Const csPDF995IniName			= "pdf995.ini"

Dim oPrintExcel
Dim nRetVal
Dim excelObj

' ﾊﾟﾗﾒｰﾀ処理用定数
Dim arrParamsKeys
arrParamsKeys = Array("-html", "-printer", "-pdf", "-syslog", "-joblog", "-jobmask", "-dpi", "-org", "-aopt")
' "-html"はbaseﾊﾟﾗﾒｰﾀです
Const cnBaseParamsIndex = 0   'arrParamsKeys配列の最初Index
Const cnHtmlKeyIndex	= 0
Const cnPrinterKeyIndex = 1
Const cnPdfKeyIndex 	= 2
Const cnSyslogKeyIndex	= 3
Const cnJoblogKeyIndex	= 4
Const cnJobmaskKeyIndex = 5
Const cnDpiKeyIndex 	= 6
Const cnOrgKeyIndex 	= 7
Const cnAOptKeyIndex	= 8

'PDFプリンタキー
Const csMainPdfKey		= "PDF"
Dim arrPdfPrinterKeys
arrPdfPrinterKeys = Array("PDF995", "PDFWriter")
Const cnPDF995KeyIndex		= 0
Const cnPDFWriterKeyIndex	= 1

'PDFファイルのDefaultDPI
Const cnDefaultPrintQuality = 600

Const csBaseHtmlExt 		= ".html"

'出力ファイル拡張子
Dim arrOutFileExts
arrOutFileExts = Array("pdf", "ps", "xls", "csv", "txt")
Const cnPdfExtIndex    = 0
Const cnPsExtIndex	   = 1
Const cnXlsExtIndex    = 2
Const cnCsvExtIndex    = 3
Const cnTxtExtIndex    = 4

'-------------------------------------------------------------------------------------
'プリンタへ出力の核心クラス
'-------------------------------------------------------------------------------------
Class PrintExcel
	Dim bIsCScript, bIsWScript
	Dim oRegExp
	Dim oFS, oSysLogFile, oJobLogFile, oWShell, oParamsDict

	Dim bIsLogging						' ログを記録するﾌﾗｸﾞ
	Dim bLogToScreen					' 画面にログを出力
	Dim bSysLogToFile, bJobLogToFile	' ファイルへログを出力
	Dim strSysLogFileName				' ログファイル名
	Dim strTempSysLogFileName			' WindowsのTempディレクトリにログを取ります
	Dim bSysLogInTemp					' ウィンドのTempにログしてある場合、設定
	Dim strJobLogFileName				' Jobログファイル名
	Dim nJobMsgFilter					' Jobログファイタ
	Dim bSetPrintQuality				' 印刷品質
	Dim nPrintQuality					' 設定した印刷品質
	Dim bMultiYkno						' 同じディレクトリに複数要求NOのHTMLファイルを合併する
	Dim bOrgCertified					' 認証した雛型

	Dim strFileName 					' 雛型ファイル名
	Dim strPrinterName					' 出力先プリンタ名
	Dim strOutFileName					' 出力先ファイル名(PDFのみ)
	Dim strBaseFileName 				' ベースとするHTMLのファイル名(拡張名除外)

	Private Sub Class_Initialize   ' Setup Initialize event.
		Dim strScript

		Set oFS 		= Nothing
		Set oSysLogFile = Nothing
		Set oJobLogFile = Nothing
		Set oWShell 	= Nothing
		Set oParamsDict = Nothing
		Set oRegExp 	= Nothing

		Set excelObj	= Nothing

		bSysLogToFile		= true
		bJobLogToFile		= true
		strSysLogFileName = csEmptyString
		'strSysLogFileName = "D:\temp\test\XXXX"
		bSysLogInTemp	= false
		bLogToScreen = true

		'Call LogMsg(cnDescription, "Begin a New PrintExcel Object。", csEmptyString)

		strScript = LCase(WScript.FullName)

		'ここにvbTextCompare = 1
		bIsCScript = ( InStr(1, strScript, "cscript", 1) > 0 )
		bIsWScript = ( InStr(1, strScript, "wscript", 1) > 0 )

		bMultiYkno		= False
		bOrgCertified	= False
		strFileName 	= csEmptyString
		strPrinterName	= csEmptyString
		strOutFileName	= csEmptyString
	End Sub

	Private Sub Class_Terminate   ' Setup Terminate event.

		Call LogMsg(cnDescription, "End of PrintExcel Object。", csEmptyString)

		'2003/10/15 Excel Close Error 対策
		If NOT excelObj IS Nothing Then
			excelObj.Quit
		End If
		Set excelObj = Nothing

		If Not oSysLogFile Is Nothing Then
			oSysLogFile.Close
			Set oSysLogFile = Nothing
		End If

		If Not oJobLogFile Is Nothing Then
			oJobLogFile.Close
			Set oJobLogFile = Nothing
		End If

		If Not oFS is Nothing Then
			Set oFS = Nothing
		End If

		If Not oWShell Is Nothing Then
			Set oWShell = Nothing
		End If

		If Not oParamsDict Is Nothing Then
			oParamsDict.RemoveAll
			Set oParamsDict = Nothing
		End If

		If Not oRegExp Is Nothing Then
			Set oRegExp = Nothing
		End If
	End Sub

	Sub ParseParams
		Dim dictParams, objArgs
		Dim arrUnnamedParams()
		Dim nKeysMaxIndex, nParamsMaxIndex
		Dim nKeysIndex, nParamsIndex
		Dim strKey, bKeyExisted, bSetToDict, bThisTimeKeySet
		Dim strCurrentKey, strCurrentValue
		Dim nNakedIndex, nUnnamedIndex

		Set dictParams = GetParamsDict()

		Set objArgs = WScript.Arguments
		nKeysMaxIndex = UBound(arrParamsKeys, 1)
		nParamsMaxIndex = objArgs.Count
		bKeyExisted = False
		bSetToDict = False
		strCurrentKey	= csEmptyString
		strCurrentValue = csEmptyString
		nNakedIndex 	= 0
		nUnnamedIndex = 0

		ReDim arrUnnamedParams(nKeysMaxIndex)

		For nParamsIndex = 0 To nParamsMaxIndex - 1 Step 1
			bThisTimeKeySet = False
			If Not bKeyExisted Then
				For Each strKey In arrParamsKeys
					If StrComp(objArgs(nParamsIndex), strKey, 1) = 0 Then
						strCurrentKey	= strKey
						bKeyExisted 	= True
						bThisTimeKeySet = True
						Exit For
					End If
				Next
			End iF

			If Not bKeyExisted Then
				If nUnnamedIndex > nKeysMaxIndex Then
					Exit For
				End If

				arrUnnamedParams(nUnnamedIndex) = objArgs(nParamsIndex)
				nUnnamedIndex = nUnnamedIndex + 1


				bSetToDict = True
			Else
				If Not bThisTimeKeySet Then
					strCurrentValue = objArgs(nParamsIndex)
					bSetToDict = True
				End If
			End If

			If bSetToDict Then
				If Not dictParams.Exists(strCurrentKey) Then
					dictParams.Add strCurrentKey, strCurrentValue
				End If
				strCurrentKey	= csEmptyString
				strCurrentValue = csEmptyString
				bKeyExisted = False
				bSetToDict	= False
			End If
		Next

		' 無印ﾊﾟﾗﾒｰﾀの処理
		nUnnamedIndex = 0
		For nNakedIndex = cnBaseParamsIndex To nKeysMaxIndex Step 1
			strCurrentKey	= arrParamsKeys(nNakedIndex)
			strCurrentValue = arrUnnamedParams(nUnnamedIndex)
			If IsEmpty( strCurrentValue) Then
				Exit For
			End If

			If Not dictParams.Exists(strCurrentKey) Then
				dictParams.Add strCurrentKey, strCurrentValue
				nUnnamedIndex = nUnnamedIndex + 1
			End If
		Next

		Set objArgs = Nothing
		Set dictParams = Nothing
		Erase arrUnnamedParams
	End Sub

	Function GetParamFromKey(strKey, strDefaultVal)
		Dim dictParams
		Set dictParams = GetParamsDict()
		If dictParams.Exists(strKey) Then
			GetParamFromKey = dictParams.Item(strKey)
		Else
			GetParamFromKey = strDefaultVal
		End If
		Set dictParams = Nothing
	End Function

	' FileSystemObjectのファクトリ
	Function GetFS()
		If oFS Is Nothing Then
			Set oFS = WScript.CreateObject("Scripting.FileSystemObject")
		End If

		Set GetFS = oFS
	End Function

	' WShellを作ります
	Function GetWShell()
		If oWShell Is Nothing Then
			' IE のレジストリにPDFWriter用の出力フォルダ名を設定する。
			Set oWShell = WScript.CreateObject("WScript.Shell")
		End If

		Set GetWShell = oWShell
	End Function

	' ﾊﾟﾗﾒｰﾀの集合
	Function GetParamsDict()
		If oParamsDict Is Nothing Then
			Set oParamsDict = WScript.CreateObject("Scripting.Dictionary")
		End If

		Set GetParamsDict = oParamsDict
	End Function

	' ここにRegular Expression (RegExp) Objectを組立
	Function GetRegExp()
		If oRegExp Is Nothing Then
			Set oRegExp = New RegExp
		End If

		Set GetRegExp = oRegExp
	End Function

	' 指定SIZEまでのLOGファイルを新規する
	Function CreateLogFileWithSizeLimit(objFS, strLogName, nFileMaxSize)
		Const ForWriting   = 2
		Const ForAppending = 8

		Dim oFile
		Dim modeIO

		On Error Resume Next 'エラー時の処理

		modeIO	   = ForWriting

		If objFS.FileExists(strLogName) Then
			Set oFile = objFS.GetFile(strLogName)
			If ( Not oFile Is Nothing ) And ( oFile.size < nFileMaxSize ) Then
				modeIO = ForAppending
			End If
			Set oFile = Nothing
		End if

		'Set CreateLogFileWithSizeLimit = objFS.CreateTextFile(strLogName, bOverwrite)
		Set CreateLogFileWithSizeLimit = objFS.OpenTextFile(strLogName, modeIO, True)
	End Function

	'ウィンドスのTempディレクトリに Log Fileを取る
	Function CreateLogInSystemTempDir( objFS, strTempLogName)
		Dim tFolder, tPath, tName, tFile
		Const TemporaryFolder = 2

		On Error Resume Next 'エラー時の処理

		Set tFile = Nothing
		Set tFolder = objFS.GetSpecialFolder(TemporaryFolder)
		If Not tFolder Is Nothing Then
			tName =   tFolder.Path & csPathSep & strTempLogName
			strTempSysLogFileName = tName
			'Set tFile = tFolder.CreateTextFile(tName)
			Set tFile = CreateLogFileWithSizeLimit(objFS, tName, cnLogFileMaxSize)
			Set tFolder = Nothing
		End If
		Set CreateLogInSystemTempDir = tFile
		Set tFile = Nothing
	End Function

	'ログファイルを作ります
	Function CreateSysLogTextFile(strLogName)
		Dim fsObj, oLogFile
		Dim dtNow, strYYYYMMDD, strLogNameInTemp
		Const strExtname = ".log"

		On Error Resume Next 'エラー時の処理

		Set fsObj = GetFS()
		dtNow = Date
		strYYYYMMDD = CStr(Year(dtNow)) _
					& Right("0" & CStr(Month(dtNow)), 2) _
					& Right("0" & CStr(Day(dtNow)), 2)

		If csEmptyString <> strLogName Then
			Set oLogFile = CreateLogFileWithSizeLimit( fsObj, _
									  strLogName & "_" & strYYYYMMDD & strExtname, cnLogFileMaxSize)
		Else
			Set oLogFile = Nothing
		End If

		If oLogFile Is Nothing Then
			bSysLogInTemp = true
			strLogNameInTemp = WScript.ScriptName & "_" & strYYYYMMDD & strExtname

			Set oLogFile = CreateLogInSystemTempDir(fsObj, strLogNameInTemp )
		End IF

		Set fsObj = Nothing

		Set CreateSysLogTextFile = oLogFile
		Set oLogFile = Nothing
	End Function

	' Jobログファイル
	Function CreateJobLogTextFile(strLogName)
		Dim fsObj
		On Error Resume Next 'エラー時の処理

		Set fsObj = GetFS()
		Set CreateJobLogTextFile = CreateLogFileWithSizeLimit( fsObj, strLogName , cnLogFileMaxSize)
		Set fsObj = Nothing
	End Function

	'メッセージをＬＯＧファイル或いは画面に出力
	Sub LogMsg( nLevel, strMsg, strAddMsg)
		Dim strLogMsg, strLevel

		On Error Resume Next 'エラー時の処理

		Select Case nLevel
			Case cnDescription	 strLevel = csDescription
			Case cnWarning		 strLevel = csWarning
			Case cnError		 strLevel = csError
			Case Else			 strLevel = csProgErr
		End Select

		strLogMsg = FormatDateTime(Now, 0) & strLevel & " " & strMsg & " " & strAddMsg

		'Log To Screen
		If bLogToScreen Then
			If ( nLevel and cnDefaultScreenMsgFilter ) Then
				WScript.Echo strLogMsg
			End If
		End If

		'システムログ Log To File
		If bSysLogToFile Then
			If ( nLevel and cnSysMsgFilter ) Then
				If oSysLogFile Is Nothing Then
					Set oSysLogFile = CreateSysLogTextFile(strSysLogFileName)

					If oSysLogFile Is Nothing Then
						bSysLogToFile = false
						Call LogMsg(cnWarning, "ｼｽﾃﾑログファイルへのﾃﾞｰﾀ出力ができません。", csEmptyString)
					Else
						IF bSysLogInTemp Then
							Call LogMsg(cnWarning, "ｼｽﾃﾑLOGファイルをｼｽﾃﾑTempに作りました。", strTempSysLogFileName)
						Else
							Call LogMsg(cnDescription, "ｼｽﾃﾑLOGファイルを作りました。", strSysLogFileName)
						End If
					End If
				End If

				If Not oSysLogFile Is Nothing Then
					oSysLogFile.WriteLine(strLogMsg)
				End If
			End If
		End If

		'Jobログ
		If bJobLogToFile Then
			If ( nLevel and nJobMsgFilter ) Then
				If oJobLogFile Is Nothing Then
					Set oJobLogFile = CreateJobLogTextFile(strJobLogFileName)
					If oJobLogFile Is Nothing Then
						bJobLogToFile = False
						Call LogMsg(cnWarning, "Jobログファイルへのﾃﾞｰﾀ出力ができません。", csEmptyString)
					Else
						Call LogMsg(cnDescription, "Jobログファイルを作りました。", strJobLogFileName)
					End If
				End If

				If Not oJobLogFile Is Nothing Then
					oJobLogFile.WriteLine(strLogMsg)
				End If
			End If
		End If
	End Sub

	Function CheckParams()
		Dim blnRet, strText

		blnRet = true

		' 引数のチェックと取り込み
		'ﾊﾟﾗﾒｰﾀをParse
		Call ParseParams

		' ｼｽﾃﾑログファイル名
		strSysLogFileName	= GetParamFromKey(arrParamsKeys(cnSyslogKeyIndex ), csEmptyString)
		strFileName 		= GetParamFromKey(arrParamsKeys(cnHtmlKeyIndex	 ), csEmptyString)
		strPrinterName		= GetParamFromKey(arrParamsKeys(cnPrinterKeyIndex), csEmptyString)
		strOutFileName		= GetParamFromKey(arrParamsKeys(cnPdfKeyIndex	 ), csEmptyString)

		strJobLogFileName	= GetParamFromKey(arrParamsKeys(cnJoblogKeyIndex ), csEmptyString)
		bJobLogToFile		= ( csEmptyString <> strJobLogFileName )
		strText 			= GetParamFromKey(arrParamsKeys(cnJobmaskKeyIndex), cnDefaultJobMsgFilter )
		If IsNumeric(strText) Then
			nJobMsgFilter	= CInt(strText)
		Else
			nJobMsgFilter	= cnDefaultJobMsgFilter
		End If

		'印刷品質パラメータの処理
		strText 	= GetParamFromKey(arrParamsKeys(cnDpiKeyIndex	 ), csEmptyString)
		If ( csEmptyString <> strText ) And IsNumeric(strText) Then
			nPrintQuality	= CInt(strText)
			bSetPrintQuality = True
		Else
			bSetPrintQuality = False
		End If

		strBaseFileName 	= GetParamFromKey(arrParamsKeys(cnOrgKeyIndex	 ), csEmptyString)
		strText 			= GetParamFromKey(arrParamsKeys(cnAOptKeyIndex	 ), csEmptyString)
		If csEmptyString <> strText Then
			'同じディレクトリに複数要求NOのHTMLファイルを合併する
			If InStr(strText, ccMultiYkno	) > 0 Then bMultiYkno	 = True

			'雛型が認証したもの
			If InStr(strText, ccOrgCertified) > 0 Then bOrgCertified = True
		End If

		If csEmptyString = strFileName Then
			Call LogMsg(cnError, "実行際に渡してきたﾊﾟﾗﾒｰﾀが不正です。", csEmptyString)
			blnRet = false
		Else
			Call LogMsg(cnDescription, "End Parameter Parsing。", csEmptyString)

			' 雛型ファイルの読み込み
			Call LogMsg(cnDescription, "ﾊﾟﾗﾒｰﾀから渡してきたファイル名：", strFileName)

			' 出力先プリンタ名の読み込み
			Call LogMsg(cnDescription, "ﾊﾟﾗﾒｰﾀから渡してきたプリンタ名：", strPrinterName)

			' 出力先ファイル名の読み込み
			Call LogMsg(cnDescription, "ﾊﾟﾗﾒｰﾀから渡してきた出力ファイル名：", strOutFileName)

			' 印刷品質
			If bSetPrintQuality Then
				Call LogMsg(cnDescription, "印刷品質(DPI)：", CStr(nPrintQuality))
			End If
			'ベースとするHTMLファイル名
			Call LogMsg(cnDescription, "Originalファイル名：", strBaseFileName)

			'確認用
			'strFileName = "F:\DOC\SYSDEP\WEBｴﾝｼﾞﾝ修正維持\070_詳細設計\帳票システム\TEST.html"
			'strPrinterName = "Ne02: の \\HN5001\EPSON LP-8900"
			'strPrinterName = "LPT1: の Acrobat PDFWriter"
			'strOutFileName = "F:\DOC\SYSDEP\WEBｴﾝｼﾞﾝ修正維持\070_詳細設計\印刷\TEST.pdf"

			'取得したファイル名のファイルを印刷する
			'blnRet = fnPrintData( strFileName,strPrinterName,strOutFileName )

			Call LogMsg(cnDescription, "End Parameter Checking。", csEmptyString)
		End If

		Call LogMsg(cnDescription, "Begin a New PrintExcel Processing。", csEmptyString)

		CheckParams = blnRet

	End Function

	' 指定のPatternでファイルを識別する
	Function IsPatternFile(strFileName, strPattern)
		' 今HTMLファイルをしか対応していない
		Dim regEx

		Set regEx = GetRegExp() 				' Create regular expression.
		regEx.Pattern = strPattern				' Set pattern.
		regEx.IgnoreCase = True 				' Set case sensitivity.
		IsPatternFile = regEx.Test(strFileName) ' Execute the search test.
		Set regEx = Nothing
	End Function

	' HTMLファイルを判別
	Function IsHtmlFile(strFileName)
		IsHtmlFile = IsPatternFile(strFileName, "(htm|html)$")
	End Function

	Function ChangeFileName(strFileName, strNamePattern, strNewName)
		Dim regEx

		Set regEx	= GetRegExp()				' Create regular expression.
		regEx.Pattern	= strNamePattern		' Set pattern.
		regEx.IgnoreCase	= True				' Set case sensitivity.
		ChangeFileName		= regEx.Replace(strFileName, strNewName)
		Set regEx = Nothing
	End Function

	' HTML拡張名をPDFに変換
	Function ChangeExtFromHtmlToPDF(strDriver, strInFile, strOutPath)
		Dim strExt, strFileOut, nIndex

		strExt = GetExtFromDriver(strDriver)
		strFileOut = ChangeFileName(strInFile, "(htm|html)$", strExt)
		'strOutPathにパースがあった場合、ファイルのパースを指定のパースに入れ替える
		If csEmptyString <> strOutPath Then
			nIndex = InStrRev(strFileOut, csPathSep, -1, 1)
			If nIndex > 0 Then
				strFileOut	= strOutPath & Mid(strFileOut, nIndex + 1 )
			End If
		End If
		ChangeExtFromHtmlToPDF = strFileOut
	End Function

	Function SetPDF995OutputFile(strFile)
		Const ReadOnly = 1, Archive = 32
		Const ForReading = 1, ForWriting = 2

		Dim fsObj, fIniContent, fIniAttr
		Dim strIniContents, strIniFileName, nOldAttributes, bIsReadOnly, oWsh
		Dim regEx
		Dim bNoError

		On Error Resume Next

		strIniFileName = csPDF995DefaultIniPath & csPathSep & csPDF995IniName

		Set fsObj = GetFS()
		Set fIniContent = fsObj.OpenTextFile(strIniFileName, ForReading)
		strIniContents = fIniContent.ReadAll
		fIniContent.Close

		Set regEx = GetRegExp() 				' Create regular expression.
		'"(Output File=.+)\r"
		regEx.Pattern = "(Output File=.+)"	' Set pattern.
		regEx.IgnoreCase = True 				' Set case sensitivity.
		If regEx.Test(strIniContents) Then
			strIniContents = regEx.Replace(strIniContents, "Output File=" & strFile )
		Else
			regEx.Pattern = "\[Parameters\]"
			strIniContents = regEx.Replace(strIniContents, "[Parameters]" & vbLf & "Output File=" & strFile )
		End if
		Set regEx = Nothing

		Set fIniAttr = fsObj.GetFile(strIniFileName)
		nOldAttributes = fIniAttr.attributes

		bIsReadOnly = (nOldAttributes and ReadOnly)
		If bIsReadOnly Then
			fIniAttr.attributes = nOldAttributes - ReadOnly
		End if
		Set fIniAttr = Nothing

		Set fIniContent = fsObj.OpenTextFile(strIniFileName, ForWriting)
		strIniContents = fIniContent.Write(strIniContents)
		fIniContent.Close

		If bIsReadOnly Then
			Set fIniAttr = fsObj.GetFile(strIniFileName)
			fIniAttr.attributes = nOldAttributes + ReadOnly
			Set fIniAttr = Nothing
		End If

		Set fsObj = Nothing

		bNoError = ( Err.Number = 0 )
		If Not bNoError Then
			Call LogMsg(cnError, "PDF995.iniへのファイル情報書き込みが失敗しました。", Err.Description)
		End If

		SetPDF995OutputFile = bNoError
	End Function


	Function IsDiskWritable(fileOut)
		Dim bRet, fsObj, oPdfFile

		On Error Resume Next
		Set fsObj = GetFS()
		Set oPdfFile = fsObj.CreateTextFile(fileOut, True)
		Set fsObj = Nothing

		If oPdfFile Is Nothing Then
			Call LogMsg(cnError, "PDFファイルへの書き込みができません。", fileOut)
			bRet	 = false
		Else
			oPdfFile.Close
			bRet	 = true
		End If
		Set oPdfFile = Nothing
		IsDiskWritable = bRet
	End Function

	'プリンタ前に、プリンタ可能かどうかﾁｪｯｸします。(近い将来、変更或いは拡張)
	Function IsPrintAllowed(printerName, fileOut)
		Dim strReg, oWsh
		Dim bRet

		bRet = True

		On Error Resume Next

		' PDF出力時の出力フォルダの取得
		If Not ( fileOut = csEmptyString ) Then
					If InStr(1, printerName, arrPdfPrinterKeys(cnPDFWriterKeyIndex), 1) > 0 Then
						bRet = IsDiskWritable(fileOut)
						If bRet Then
							strReg = "HKCU\Software\Adobe\Acrobat PDFWriter\PDFFileName"
							Set oWsh = GetWShell()
							Err.Clear
							oWsh.RegWrite strReg, fileOut, "REG_SZ"
							If Err.Number <> 0 Then
								Call LogMsg(cnError, "PDFWriteのRegisterへの書き込み：", Err.Description)
								bRet	 = false
							End if
							Set oWsh = Nothing
						End If
					ElseIF InStr(1, printerName, arrPdfPrinterKeys(cnPDF995KeyIndex), 1) > 0 Then
						bRet = IsDiskWritable(fileOut)
						If bRet Then
						bRet = SetPDF995OutputFile(fileOut)
						End if
					Else
						bRet	 = True
					End If
		End If

		IsPrintAllowed = bRet
	End Function

	' ワークブックを印刷する
	Function PrintWooksheet(oWorkbook, strPrinter)
		Dim bNoPrintErr, bHasPrinter, strCurrentPrinter
		Dim oExcel, oSheet

		On Error Resume Next

		Set oExcel = oWorkbook.Application
		bHasPrinter = ( csEmptyString <> strPrinter )
		If bHasPrinter Then
			'strCurrentPrinter = oExcel.ActivePrinter		' 現在のプリンタ名を退避( 2006/09/12 廃止)
			' プリンタ名の設定
			oExcel.ActivePrinter = strPrinter
			bNoPrintErr = Not CBool( Err.Number)
			Err.Clear
			If Not bNoPrintErr Then
				Call LogMsg(cnError, "指定したプリンタが不正です。", strPrinter)
			End If

			If bNoPrintErr And bSetPrintQuality And ( InStr(1, strPrinter, csMainPdfKey, 1) > 0 ) Then
				'印刷品質をセット
				For Each oSheet In oWorkbook.Worksheets
					oSheet.PageSetup.PrintQuality = nPrintQuality
				Next
			End If
		End If

		If bNoPrintErr Then
			' 印刷処理
			'PrintOut([From], [To], [Copies], [Preview], [ActivePrinter], [PrintToFile], [Collate], [PrToFileName])
			'oWorkbook.Worksheets.PrintOut , , , , strPrinter, , True
			oWorkbook.Worksheets.PrintOut , , , , , , True

			bNoPrintErr = ( Err.Number = 0 )
			If bNoPrintErr Then
				Call LogMsg(cnDescription, "ファイルを印刷しました。", csEmptyString)
			Else
				Call LogMsg(cnError, Err.Description, csEmptyString)
			End If
		End If

		' 2006/09/12 プリンタ戻しを廃止します。
		'If bHasPrinter Then
		'	oExcel.ActivePrinter = strCurrentPrinter
		'End If
		Set oExcel = Nothing

		PrintWooksheet = bNoPrintErr
	End Function

	' ワークブックを出力する
	Function SaveWooksheet(oWorkbook, nFileFormat, strFileOut)
		Dim bSaveStatus

		On Error Resume Next

		' 特別な形式ファイルを保存する
		oWorkbook.SaveAs strFileOut, nFileFormat, "", "", False, False

		bSaveStatus = ( Err.Number = 0 )
		If bSaveStatus Then
			Call LogMsg(cnDescription, "ファイルを保存しました。", strFileOut)
		Else
			Call LogMsg(cnError, Err.Description, csEmptyString)
		End If

		SaveWooksheet = bSaveStatus
	End Function

	Function OutputWooksheet(oWorkbook, strPrinter, strFileOut)
		Dim bOutput

		Select Case LCase(strPrinter)
		Case arrOutFileExts(cnXlsExtIndex)
			'xlsフィル出力
			'Const xlNormal = -4143
			bOutput = SaveWooksheet(oWorkbook, -4143, strFileOut)
		Case arrOutFileExts(cnTxtExtIndex)
			'Const xlText = -4158
			bOutput = SaveWooksheet(oWorkbook, -4158, strFileOut)
		Case Else
			'PDF出力
			bOutput = IsPrintAllowed(strPrinter, strFileOut)
			If bOutput Then
				bOutput = PrintWooksheet(oWorkBook, strPrinter)
			End IF
		End Select
		OutputWooksheet = bOutput
	End Function

	Function GetExtFromDriver(strDriver)
		Dim strKey, bKeyExisted
		bKeyExisted = False
		For Each strKey In arrOutFileExts
			If Instr(1, LCase(strDriver), strKey, 1) > 0 Then
				bKeyExisted 	= True
				Exit For
			End If
		Next

		If bKeyExisted Then
			GetExtFromDriver = strKey
		Else
			GetExtFromDriver = arrOutFileExts(cnPdfExtIndex)
		End If
	End Function

	Function SetWorksheetsName(oWorkbook, strFileName)
		Dim oWorksheets
		Dim bRet, nCount, nIndex
		Dim strFileBaseName

		bRet = True
		strFileBaseName = csEmptyString
		If Not ( oWorkbook Is Nothing ) Then

			nIndex = InStrRev(strFileName, csPathSep, -1, 1)
			If nIndex > 0 Then
				strFileBaseName = Mid(strFileName, nIndex + 1 )
			Else
				strFileBaseName = strFileName
			End If
			nIndex = InStr(1, strFileBaseName, csExtSep, 1)
			If nIndex > 0 Then
				strFileBaseName = Left(strFileBaseName, nIndex - 1 )
			End If

			If csEmptyString <> strFileBaseName Then
				Set oWorksheets = oWorkbook.Worksheets
				nCount = oWorksheets.Count
				If 1 = nCount Then
					oWorksheets(1).Name = strFileBaseName
				Else
					For nIndex = 1 To nCount Step 1
						oWorksheets(nIndex).Name = strFileBaseName & "(" & CStr(nIndex) & ")"
					Next
				End If

				Set oWorksheets = Nothing
			End If
		End If

		SetWorksheetsName = bRet
	End Function

	' 一つのワークブックを作ります
	Function ConbineHtmlToOneWorkbook(oExcel, oMainWorkbook, strHtmlFilename, strBaseHtml)
		Const xlWBATWorksheet = -4167
		Dim oInternalWorkbook, oSlaveWorkbook
		Dim fsObj, strRealHtmlFile
		Dim bRet, bHasBaseHtml

		On Error Resume Next
		Set ConbineHtmlToOneWorkbook = Nothing

		bRet = True
		bHasBaseHtml = ( csEmptyString <> strBaseHtml)
		If bHasBaseHtml Then
			Set fsObj = GetFS()
			Call fsObj.CopyFile(strHtmlFilename, strBaseHtml, True )
			bRet = ( 0 = Err.Number )

			If bRet Then
				Call LogMsg(cnDescription, "Htmlファイルをベースファイルにコピーしました。", strHtmlFilename)
				strRealHtmlFile = strBaseHtml
			Else
				Call LogMsg(cnError, Err.Description, strHtmlFilename)
			End If
			Set fsObj = Nothing
		Else
			strRealHtmlFile = strHtmlFilename
		End If

		If bRet Then
			Set oInternalWorkbook = Nothing
			If oMainWorkbook Is Nothing Then
				If bHasBaseHtml Then
					Set oInternalWorkbook = oExcel.Workbooks.Add(xlWBATWorksheet)
					Set oSlaveWorkbook		= oExcel.Workbooks.Open(strRealHtmlFile, , true)
					Call oSlaveWorkbook.Worksheets.Move(, oInternalWorkbook.Worksheets(oInternalWorkbook.Worksheets.Count))
					'認証した雛型が削除すると、警告がでる
					If Not bOrgCertified Then
					oInternalWorkbook.Worksheets(1).Delete
					End If
				Else
					Set oInternalWorkbook = oExcel.Workbooks.Open(strRealHtmlFile, , true)
				End If

				bRet = ( 0 = Err.Number  )
				If bRet Then
					Call SetWorksheetsName(oInternalWorkbook, strHtmlFilename)
				Else
					Call LogMsg(cnError, Err.Description, csEmptyString)
				End If
			Else
				Set oSlaveWorkbook = oExcel.Workbooks.Open(strRealHtmlFile, , true)
				bRet = ( Err.Number = 0 )
				If Not bRet Then
					Call LogMsg(cnError, Err.Description, csEmptyString)
				Else
					Call SetWorksheetsName(oSlaveWorkbook, strHtmlFilename)
					Call oSlaveWorkbook.Worksheets.Move(, oMainWorkbook.Worksheets(oMainWorkbook.Worksheets.Count))

					bRet = ( Err.Number = 0 )
					If Not bRet Then
						Call LogMsg(cnError, Err.Description, csEmptyString)
					End If

					Set oInternalWorkbook = oMainWorkbook
				End If
				Set oSlaveWorkbook = Nothing

				If Not bRet Then oMainWorkbook.Close( False )
			End if

			If bRet Then
				Set ConbineHtmlToOneWorkbook = oInternalWorkbook
				Call LogMsg(cnDescription, "ExcelにファイルをLoadしました。", strRealHtmlFile)
			End If
			Set oInternalWorkbook = Nothing
		End If

	End Function

	' PDF印刷を行うファイルに対する処理のためのサブルーチン
	Function File2Printer(oExcel, printerName, fileIn,	fileOut)
		Dim oWorkBook
		Dim bRet, strBaseHtmlFile

		bRet = True

		On Error Resume Next

		Call LogMsg(cnDescription, "Excelでファイルを開き始めます…", fileIn)

		' ベースファイル名を作る
		If csEmptyString = strBaseFileName Then
			strBaseHtmlFile = csEmptyString
		Else
			strBaseHtmlFile = ChangeFileName(fileIn, "[^\\]+$", strBaseFileName & csBaseHtmlExt )
		End If

		'Set oWorkBook = oExcel.Workbooks.Open(fileIn, , true)
		Set oWorkBook = ConbineHtmlToOneWorkbook(oExcel, Nothing, fileIn, strBaseHtmlFile)
		If oWorkBook Is Nothing Then
			Call LogMsg(cnError, "ファイルをExcelで開けませんでした。", fileIn)
			bRet = False
		Else
			bRet = OutputWooksheet(oWorkBook, printerName, fileOut)
			oWorkBook.Close( false )
			Set oWorkBook = Nothing
		End IF

		File2Printer = bRet
	End Function

	' PDF印刷を行うファイルに対する処理のためのサブルーチン
	Function Dir2Printer(oExcel, printerName, pathIn, filePattern, fileOut)
		Dim fsObj, folderObj, fileObj
		Dim oWorkBook
		Dim strSingleFileName, strRealPattern, strBaseHtmlFile
		Dim bOutputToSingleFile, bPatternFile
		Dim bRet, bHasPattern

		bRet = True

		On Error Resume Next

		Set oWorkBook = Nothing
		'入力ファイルを一つのファイルに出力するか？(2005年09月09日 Comment Out)
		'bOutputToSingleFile = ( ( csEmptyString <> fileOut ) And ( csPathSep <> Right(fileOut, 1) ) )
		bOutputToSingleFile = True

		bHasPattern = ( csEmptyString <> filePattern )
		If bHasPattern Then
			strRealPattern = Replace(filePattern,	 ".", "\.", 1, -1, 1)
			strRealPattern = Replace(strRealPattern, "*", ".*", 1, -1, 1)
		End If

		Call LogMsg(cnDescription, "ディレクトリ中にファイルのプリンテングを始めます…", pathIn)
		Set fsObj = GetFS()
		Set folderObj = fsObj.GetFolder(pathIn)

		' ベースファイル名を作る
		If csEmptyString = strBaseFileName Then
			strBaseHtmlFile = csEmptyString
		Else
			strBaseHtmlFile = pathIn & csPathSep & strBaseFileName & csBaseHtmlExt
		End If

		For Each fileObj In folderObj.Files
			strSingleFileName = pathIn & csPathSep & fileObj.Name
			If Not IsHtmlFile(strSingleFileName) Then
				' ここにエラーでない。大量のﾃﾞｰﾀを処理する場合に、HTMLファイルだけを処理します
				Call LogMsg(cnWarning, "HTMLでないファイルを処理できません(未対応)。", strSingleFileName)
			Else

				bPatternFile = True
				If bHasPattern Then
					bPatternFile = IsPatternFile(strSingleFileName, strRealPattern )
				End If

				If bPatternFile Then
					If bOutputToSingleFile Then
						Set oWorkBook = ConbineHtmlToOneWorkbook(oExcel, oWorkBook, strSingleFileName, strBaseHtmlFile)
						If oWorkBook Is Nothing Then
							bRet = False
							Exit For
						End If
					Else
						bRet = File2Printer(oExcel, strPrinterName, _
												  strSingleFileName ,  _
												  ChangeExtFromHtmlToPDF(printerName, strSingleFileName, fileOut))
						If Not bRet Then Exit For
					End If
				'2005年09月09に Comment Out
				'Else
				'	Call LogMsg(cnWarning, "該当のPatternに属していないファイルを処理していません。", strSingleFileName)
				End If
			End If
		Next
		Set folderObj = Nothing
		Set fsObj = Nothing

		' 組み合わせた一つのPDFファイルを印刷
		If bRet And bOutputToSingleFile Then
			If oWorkBook Is Nothing Then
				Call LogMsg(cnWarning, "印刷できるファイルが存在しません。", pathIn)
			Else
				Call LogMsg(cnDescription, "ファイルの印刷を始めます…", pathIn)

				bRet = OutputWooksheet(oWorkBook, printerName, fileOut)
				If Not oWorkBook Is Nothing Then
					oWorkBook.Close( False )
				End If
			End If
			Set oWorkBook = Nothing
		End If

		Dir2Printer = bRet
	End Function

	'指定されたファイル名のファイルを印刷する
	Function PrintData( strFileName, strPrinterName, strOutFileName )
		'Dim excelObj
		Dim fsObj
		Dim strPathName, strFilePattern, nIndex
		Dim blnRet

		blnRet = true

		On Error Resume Next 'エラー時の処理

		Call LogMsg(cnDescription, "Excelを起動します…", csEmptyString)

		Set excelObj = WScript.CreateObject("Excel.Application")

		If excelObj Is Nothing Then
			Call LogMsg(cnError, "Excelを起動できませんでした。", csEmptyString)
			blnRet = False
		else
			excelObj.Visible = False
			'excelObj.Visible = True
			' 途中のダアログを出さん
			excelObj.DisplayAlerts = False

			Set fsObj = GetFS()

			If ( fsObj.FileExists(strFileName) ) Then
				If Not IsHtmlFile(strFileName) Then
					Call LogMsg(cnError, "HTMLでないファイルを印刷できません(未対応)。", strFileName)
					blnRet = False
				Else
					Call LogMsg(cnDescription, "一つファイルのプリンテングを始まります…", strFileName)
					blnRet = File2Printer(excelObj, strPrinterName, strFileName,  strOutFileName)
				End If
			Else
				'このC:\temp\Test*.htmlような形ファイル名に対応
				nIndex = InStrRev(strFileName, csPathSep, -1, 1)
				If nIndex > 0 Then
					strPathName 	= Left(strFileName, nIndex - 1)
					'同じディレクトリに複数要求NOのHTMLファイルを合併する
					If	bMultiYkno	  Then
					strFilePattern	= "*.html"
					Else
					strFilePattern	= Mid(strFileName, nIndex + 1 )
					End If
				End If
				If (nIndex > 0) And (csEmptyString <> strPathName) Then
					If fsObj.FolderExists(strPathName) Then
						blnRet = Dir2Printer(excelObj, strPrinterName, strPathName, strFilePattern,  strOutFileName)
					End If
				Else
					Call LogMsg(cnError, "処理するファイルは存在しません。", strFileName)
					blnRet = false
				End If
			End IF

			Set fsObj = Nothing

			If NOT excelObj IS Nothing Then
				excelObj.Quit
			End If
			Set excelObj = Nothing
			Call LogMsg(cnDescription, "End of Excel Close。", csEmptyString)
		End if

		PrintData = blnRet
	End Function

	Public Function Print()
		Dim nRet

		nRet = 0
		If Not CheckParams() Then
			nRet = 1
		ElseIf Not PrintData( strFileName, strPrinterName, strOutFileName ) then
			nRet = 2
		End if
		Print = nRet
	End Function

End Class

'-------------------------------------------------------------------------------------
'プログラムをここから実行する
'-------------------------------------------------------------------------------------
Set oPrintExcel = New PrintExcel	' Create an instance of TestClass.
nRetVal = oPrintExcel.Print()		' Print Data
Set oPrintExcel = Nothing			' Destroy the instance.

'-------------------------------------------------------------------------------------
'プログラムを終了させる
'-------------------------------------------------------------------------------------
'WScript.Sleep( 10000 )
WScript.Quit( nRetVal )

