Macroの杜
(OpenOffice.org/LibreOffice Basic編)

< 前 General No.5 次 >

**********************【 Index 】**********************

JavaScript

GJS-)[General]JavaScript Macro(1)
[ GetDefaultContext.getValueByName( "/singletons/com.sun.star.script.provider.theMasterScriptProviderFactory") / createScriptProvider("") / getScript("vnd.sun.star.script:Library1.Macro1.js?language=JavaScript&location=user") / invoke() ]
GJS-)[General]JavaScript Macro(2) / 他DocumentのMacro[ ThisComponent.ScriptProvider ]
GJS-)[General]VBAのEvaluate関数[ Function ]
GJS-)[General][ ]

Python

GPy-)[General]Python Macro(1)
[ GetDefaultContext.getValueByName( "/singletons/com.sun.star.script.provider.theMasterScriptProviderFactory") / createScriptProvider("") / getScript("vnd.sun.star.script:test.py$oTest?language=Python&location=user / invoke() ]
GPy-)[General]Python Macro(2) / 他DocumentのMacro[ ThisComponent.ScriptProvider ]
GPy-)[General][ ]

VBScript

[ FileSystemObject ]

GVBSFs-)[General]File有無確認[ CreateObject("Scripting.FileSystemObject") / FileExists ]
GVBSFs-)[General]Folder有無確認[ FolderExists ]
GVBSFs-)[General]Drive有無確認[ DriveExists ]
GVBSFs-)[General]File名を抽出[ GetFileName ]
GVBSFs-)[General]Exe FileのVresion取得[ GetFileVersion ]
GVBSFs-)[General]Current Folder + File Name[ GetAbsolutePathName ]
GVBSFs-)[General]Drive Name抽出[ GetDriveName ]
GVBSFs-)[General]Base File Name( 拡張子を除いたFile Name )抽出[ GetBaseName ]
GVBSFs-)[General]拡張子の抽出[ GetExtensionName ]
GVBSFs-)[General]Parent Folder抽出[ GetParentFolderName ]
GVBSFs-)[General]特殊Folder取得[ GetSpecialFolder ]
GVBSFs-)[General]Temporary File取得[ GetTempName ]
GVBSFs-)[General]File Information取得( using FileSystemObject )[ GetFile / Name / Type / Size / DateCreated / DateLastAccessed / DateLastModified / Value ]
GVBSFs-)[General]Fileの読み取り専用を解除[ Attributes / And 1 / And &HFE ]
GVBSFs-)[General]File( or Folder )の属性取得[ Attributes ]
GVBSFs-)[General][ ]
GVBSFs-)[General][ ]

[ VBScript.RegExp(正規表現) ](正規表現による Visual Basic Scripting Edition (VBScript) の機能強化)

GVBSRE-)[General]検索[ Test ]
GVBSRE-)[General]置換[ Replace ]
GVBSRE-)[General]Matche数[ Execute / Count ]
GVBSRE-)[General]MatcheしたItem取得[ Execute / Item / FirstIndex ]

[ WshShell ]

GVBSWhS-)[General]Programの実行[ WScript.Shell / Exec ]
GVBSWhS-)[General]Programが終了するまで待機(1)[ Status ]
GVBSWhS-)[General]Programが終了するまで待機(2)[ Simple boot ][ Run ]
GVBSWhS-)[General]Programを強制終了[ Terminate ]
GVBSWhS-)[General]Programの終了Status取得[ ExitCode ]
GVBSWhS-)[General]ProgramのProcess ID取得[ AppActivate / ProcessID ]
GVBSWhS-)[General]Current Folder取得[ CurrentDirectory ]
GVBSWhS-)[General]Current Folder変更[ CurrentDirectory ]
GVBSWhS-)[General]時限付messagebox[ Popup ]
GVBSWhS-)[General]PCのCPU[ .Environment("Process").Item("PROCESSOR_ARCHITECTURE") ]
GVBSWhS-)[General]動画再生( Windows Media Player )[ ]
GVBSWhS-)[General]PowerShell起動[ PowerShell ]
GVBSWhS-)[General][ ]

[ Shell.Application ]

GVBSShAp-)[General]Folder選択Dialog[ BrowseForFolder ]
GVBSShAp-)[General]Exploreを開く[ Explore ]
GVBSShAp-)[General]File名を指定して実行 Windowを開く[ FileRun ]
GVBSShAp-)[General]File と Folderの検索 Windowを開く[ FindFiles ]
GVBSShAp-)[General]WindowsのHelpを開く[ Help ]
GVBSShAp-)[General]全てのWindowの最少化 / 最少化解除[ MinimizeAll / UndoMinimizeAll ]
GVBSShAp-)[General]日付と時刻の設定 Windowを開く[ SetTime ]
GVBSShAp-)[General]Windowsの Shutdown画面を開く[ ShutdownWindows ]
GVBSShAp-)[General]Taskbar と Start Menuの設定画面を開く[ TrayProperties ]
GVBSShAp-)[General]File Information取得( using Shell.Application )[ .NameSpace / ParseName / Type / Parent / Size / ModifyDate / Value ]
GVBSShAp-)[General][ ]

[ Scripting.Dictionary ]

[ WScript.Network ]

GVBSWsNt-)[General]Network Information取得[ UserDomain / ComputerName / UserName ]
GVBSWsNt-)[General]Default Printer設定[ SetDefaultPrinter ]
GVBSWsNt-)[General]Printer List取得[ EnumPrinterConnections ]
GVBSWsNt-)[General][ ]

[ WbemScripting.SWbemLocator ]

GVBWbLr-)[General]起動中のProcess数取得[ WbemScripting.SWbemLocator / ExecQuery / Win32_Process / count ]
GVBWbLr-)[General]特定Applicationの起動数取得[ Where Caption='' ]

[ Msxml2.ServerXMLHTTP / htmlfile ]

GVBHttpHF-)[General]Site Data取得[ Msxml2.ServerXMLHTTP / htmlfile / .responseText / .Title ]
GVBHttpHF-)[General][ ]

[ MS-Office ]

{{ General }}

GVBSMsGn-)[General]Excel起動[ Excel.Application / Workbooks / Add ]
GVBSMsGn-)[General]Word起動[ Word.Application / Quit(wdDoNotSaveChanges) ]
GVBSMsGn-)[General][ ]

{{ Other }}

GVBSMsOtr-)[General]VBA実行[ vnd.sun.star.script:VBAProject.Module1 / .invoke ]

[ Internet Explorer ]

GVBSIe-)[General]IE起動(VBS)[ InternetExplorer.Application / Navigate / Visible ]
GVBSIe-)[General]IE起動2( Home Page表示 )[ GoHome ]
GVBSIe-)[General]IE終了[ Qiut ]
GVBSIe-)[General]読込み完了確認(1)[ Busy ]
GVBSIe-)[General]読込み完了確認(2)[ ReadyState ]
GVBSIe-)[General]戻る / 進む / 中止[ GoBack / GoForward / Stop ]
GVBSIe-)[General]Current siteのURL取得[ LocationURL ]
GVBSIe-)[General]Current siteのTitle Name取得[ LocationName ]
GVBSIe-)[General]Screen updates[ Refresh ]
GVBSIe-)[General]Windowの位置とSize設定[ Width / Height / Top / Left ]
GVBSIe-)[General]WindowのFull Screen表示[ ]
GVBSIe-)[General]Adress Bar表示/非表示[ AddressBar ]
GVBSIe-)[General]Site Source取得( Body部のTextのみ )[ .Document.Body.innerText ]
GVBSIe-)[General][ ]

Win32 API

[ user32.dll ]

GWin32User32-)[General]Messagebox[ MessageBox Lib 'user32.dll' / MB_ABORTRETRYIGNORE / MB_CANCELTRYCONTINUE / MB_HELP / MB_OK / MB_OKCANCEL / MB_RETRYCANCEL / MB_YESNO / MB_YESNOCANCEL / MB_ICONEXCLAMATION / MB_ICONWARNING / MB_ICONINFORMATION / MB_ICONASTERISK / MB_ICONQUESTION / MB_ICONSTOP / MB_ICONERROR / MB_ICONHAND / MB_DEFBUTTON1 / MB_DEFBUTTON2 / MB_DEFBUTTON3 / MB_DEFBUTTON4 / MB_APPLMODAL / MB_SYSTEMMODAL / MB_TASKMODAL / MB_DEFAULT_DESKTOP_ONLY / MB_RIGHT / MB_RTLREADING / MB_SETFOREGROUND / MB_TOPMOST / MB_SERVICE_NOTIFICATION ]
GWin32User32-)[General][ ]

PowerShell

GPS-)[General]圧縮/解凍[ powershell / Compress-Archive / Expand-Archive ]
GPS-)[General]MsgBox[ ]

**********************【 Macro Code 】**********************

JavaScript

Sub oJavaScriptMacro
	Dim oMSPF as Object
	Dim oSP as Object
	Dim oScript as Object
		oMSPF = GetDefaultContext.getValueByName( "/singletons/com.sun.star.script.provider.theMasterScriptProviderFactory")
 		oSP = oMSPF.createScriptProvider("")
 	' JavaScript Macro
		oScript = oSP.getScript("vnd.sun.star.script:Library1.Macro1.js?language=JavaScript&location=user") 
	' Macro実行
		oScript.invoke( array(),array(),array())	
End Sub
'
' [ JavaScript Macro ]
' マイマクロ/Library1/Macro1.js
'C:\Users\[UserName]\AppData\Roaming\LibreOffice\3\user\Scripts\javascript\Library1\Macro1.js
//
// Hello World in JavaScript
importClass(Packages.javax.swing.JOptionPane);
JOptionPane.showMessageDialog(null, "Hello World in JavaScript");

Sub oJavaScriptMacro
	Dim oSP as Object
	Dim oScript as Object
 		oSP = ThisComponent.ScriptProvider
 	' JavaScript Macro
		oScript = oSP.getScript("vnd.sun.star.script:Library1.Macro1.js?language=JavaScript&location=user") 
	' Macro実行
		oScript.invoke( array(),array(),array())	
End Sub
'
' [ JavaScript Macro ]
' マイマクロ/Library1/Macro1.js
'C:\Users\[UserName]\AppData\Roaming\LibreOffice\3\user\Scripts\javascript\Library1\Macro1.js
//
// Hello World in JavaScript
importClass(Packages.javax.swing.JOptionPane);
JOptionPane.showMessageDialog(null, "Hello World in JavaScript");

Sub oEvaluateofVBA
	Dim oStrEval as Double
	Dim oDisp as String
		oStrEval = Eval("1.5+2.6")
		oDisp = "[ VBAのApplication.Evaluate ]" & Chr$(10) & _
				" Eval(""1.5+2.6"") = " & oStrEval
		msgbox oDisp,0,"Evaluate関数"
End Sub
'
Function Eval(oString as String) as Double
	Dim oSP as Object
	Dim oScript as Object
 		oSP = ThisComponent.ScriptProvider
 	' JavaScript Macro
		oScript = oSP.getScript("vnd.sun.star.script:Library1.Evaluate1.js?language=JavaScript&location=user") 
	' Macro実行
		Eval  = oScript.invoke( array(oString),array(1),array(JsResult))
End Function
'
'
' [ JavaScript Macro ]
' マイマクロ/Library1/Evaluate1.js
//
// Evaluate
JsResult = eval(String(ARGUMENTS[0]));
//
'
' 上記Functionを設定していればUser定義関数としてCalcの関数として使える。(右図)

Python

Sub Python_Macro
	Dim oMSPF as Object
	Dim oSP as Object
	Dim oScript as Object
 		oMSPF = GetDefaultContext.getValueByName( "/singletons/com.sun.star.script.provider.theMasterScriptProviderFactory")
 		oSP = oMSPF.createScriptProvider("")
 	' Python Macro
		oScript = oSP.getScript("vnd.sun.star.script:test.py$oTest?language=Python&location=user") 
	' Macro実行
		oScript.invoke( array(),array(),array())	
End Sub
'
' [ Python Macro ]
' マイマクロ/test.py / def oTest(): 
'C:\Users\[UserName]\AppData\Roaming\LibreOffice\3\user\Scripts\python\test.py
#
#!
#coding: UTF-8
# python Marco
import itertools
import sys
import uno
import sys
import traceback
from com.sun.star.awt import Rectangle
def omsgbox(oMessage='',oBtnType=1,oTitle='Title',oMsgType='messbox'):
#	"""shows message."""
		desktop = XSCRIPTCONTEXT.getDesktop()
		frame = desktop.getCurrentFrame()
		window = frame.getContainerWindow()
		toolkit = window.getToolkit()
		msgbox = toolkit.createMessageBox(window, Rectangle(), oMsgType, oBtnType, oTitle, oMessage)
		return msgbox.execute()
def oTest():
	try:
		# Unfinite Iterator
		oStr = 'ABC'
		oLmt = 3
		# oLmtの引数を省略すると無限Iteratorになる。
		oIterObj = itertools.repeat(oStr, oLmt)		# ABC ABC ABC
		oIter = oIterObj.__iter__()
		oDisp = unicode('[ Unifite Iterator ]\n','utf-8')
		for i in oIter:
			oDisp = oDisp + str(i) + '\n'
	except:
		oDisp = traceback.format_exc(sys.exc_info()[2])
	finally:
		omsgbox(oDisp,1)

Sub PythonMacro
	Dim oSP as Object
	Dim oScript as Object
 		oSP = ThisComponent.ScriptProvider
 	' Python Macro
		oScript = oSP.getScript("vnd.sun.star.script:test.py$oTest?language=Python&location=user") 
	' Macro実行
		oScript.invoke( array(),array(),array())	
End Sub
'
' [ Python Macro ]
' マイマクロ/test.py / def oTest(): 
'C:\Users\[UserName]\AppData\Roaming\LibreOffice\3\user\Scripts\python\test.py
#
#!
#coding: UTF-8
# python Marco
import re
import uno
import sys
import traceback
from com.sun.star.awt import Rectangle
def omsgbox(oMessage='',oBtnType=1,oTitle='Title',oMsgType='messbox'):
#	"""shows message."""
		desktop = XSCRIPTCONTEXT.getDesktop()
		frame = desktop.getCurrentFrame()
		window = frame.getContainerWindow()
		toolkit = window.getToolkit()
		msgbox = toolkit.createMessageBox(window, Rectangle(), oMsgType, oBtnType, oTitle, oMessage)
		return msgbox.execute()
def oTest():
	try:
		oDisp = u('処理を続けますか?')
		oAns = omsgbox(oDisp,2,'Normal Box','messbox')
		oDisp = 'Return => ' + str(oAns)
	except:
		oDisp = traceback.format_exc(sys.exc_info()[2])
	finally:
		omsgbox(oDisp,1)

VBScript

[ FileSystemObject ]

Sub oFSObject()
	Dim oFSObj as Object
	Dim oFile as String
		set oFSObj = CreateObject("Scripting.FileSystemObject")
		oFile = "C:\temp\OOoTest.csv"	
		If oFSObj.FileExists(oFile) then
			MsgBox( oFile & " は存在します", 0, "File Exist")
		else
			MsgBox( oFile & " は存在しません", 0, "Caution !!")
		End If
		'
		set oFSObj = Nothing
		msgbox "Success",0,"End Code"
End Sub

Sub oFSObject()
	Dim oFSObj as Object
	Dim oFolder as String
		set oFSObj = CreateObject("Scripting.FileSystemObject")
		oFolder = "C:\temp"	
		If oFSObj.FolderExists(oFolder) then
			MsgBox( oFolder & " Folder は存在します", 0, "FileSystemObject")
		else
			MsgBox( oFolder & " Folder は存在しません", 0, "Caution !!")
		End If
		'
		set oFSObj = Nothing
		msgbox "Success",0,"End Code"
End Sub

Sub oFSObject()
	Dim oFSObj as Object
	Dim oDrive() as String
	Dim oDisp as String
		set oFSObj = CreateObject("Scripting.FileSystemObject")
		oDrive = Array("A:","C:","D:")	
		oDisp = ""
		for each oDrName in oDrive
			if oFSObj.DriveExists(oDrName)　then
				oDisp = oDisp & oDrName & " Driveは存在します。" & Chr(10)
			else
				oDisp = oDisp & oDrName & " Driveは存在しません。" & Chr(10)
			end if
		next oDrName
		'
		set oFSObj = Nothing
		msgbox oDisp,0,"End Code"
End Sub

Sub oFSObject()
	Dim oFSObj as Object
	Dim oFile as String
	Dim oFName as String
		set oFSObj = CreateObject("Scripting.FileSystemObject")
		oFile = "C:\temp\OOoTest.csv"
		oFName = oFSObj.GetFileName(oFile)
		'
		oDisp = oFile & Chr(10) & " → " & oFName
		msgbox oDisp,0,"FileSystemObject"
		'
		set oFSObj = Nothing
		msgbox "Success",0,"End Code"
End Sub

Sub oFSObject()
	Dim oFSObj as Object
	Dim oExeFile as String
	Dim oVersion as String
		set oFSObj = CreateObject("Scripting.FileSystemObject")
		oExeFile = "C:\Program Files\Mozilla Firefox\firefox.exe"
		oVersion = oFSObj.GetFileVersion(oExeFile)
		'
		oDisp = oExeFile & Chr(10) & " → Ver." & oVersion
		msgbox oDisp,0,"FileSystemObject"
		'
		set oFSObj = Nothing
		msgbox "Success",0,"End Code"
End Sub

Sub oFSObject()
	Dim oFSObj as Object
	Dim oFile as String
	Dim oAbsFile as String
		set oFSObj = CreateObject("Scripting.FileSystemObject")
		oFile = "Dummy.txt"
		oAbsFile = oFSObj.GetAbsolutePathName(oFile)
		'
		oDisp = oAbsFile
		msgbox oDisp,0,"FileSystemObject"
		'
		set oFSObj = Nothing
		msgbox "Success",0,"End Code"
End Sub

Sub oFSObject()
	Dim oFSObj as Object
	Dim oFile as String
	Dim oDriveName as String
		set oFSObj = CreateObject("Scripting.FileSystemObject")
		oFile = "c:\Temp\Dummy.txt"
		oDriveName = oFSObj.GetDriveName(oFile)
		'
		oDisp = oFile & Chr(10) & " → " & oDriveName
		msgbox oDisp,0,"FileSystemObject"
		'
		set oFSObj = Nothing
		msgbox "Success",0,"End Code"
End Sub

Sub oFSObject()
	Dim oFSObj as Object
	Dim oFile as String
	Dim oBaseName as String
		set oFSObj = CreateObject("Scripting.FileSystemObject")
		oFile = "c:\Temp\Dummy.txt"
		oBaseName = oFSObj.GetBaseName(oFile)
		'
		oDisp = oFile & Chr(10) & " → " & oBaseName
		msgbox oDisp,0,"FileSystemObject"
		'
		set oFSObj = Nothing
		msgbox "Success",0,"End Code"
End Sub

Sub oFSObject()
	Dim oFSObj as Object
	Dim oFile as String
	Dim oExtentName as String
		set oFSObj = CreateObject("Scripting.FileSystemObject")
		oFile = "c:\Temp\MacroCalc.ods"
		oExtentName = oFSObj.GetExtensionName(oFile)
		'
		oDisp = oFile & Chr(10) & " → " & oExtentName
		msgbox oDisp,0,"FileSystemObject"
		'
		set oFSObj = Nothing
		msgbox "Success",0,"End Code"
End Sub

Sub oFSObject()
	Dim oFSObj as Object
	Dim oFile as String
	Dim oParentName as String
		set oFSObj = CreateObject("Scripting.FileSystemObject")
		oFile = "c:\Temp\MacroCalc.ods"
		oParentName = oFSObj.GetParentFolderName(oFile)
		'
		oDisp = oFile & Chr(10) & " → " & oParentName
		msgbox oDisp,0,"FileSystemObject"
		'
		set oFSObj = Nothing
		msgbox "Success",0,"End Code"
End Sub

Sub oFSObject()
	Dim oFSObj as Object
	Dim oDisp as String
	Dim oWinFldr as String
	Dim oSysFldr as String
	Dim oTmpFldr as String
		set oFSObj = CreateObject("Scripting.FileSystemObject")
		'
		oWinFldr = oFSObj.GetSpecialFolder(0)
		oSysFldr = oFSObj.GetSpecialFolder(1)
		oTmpFldr = oFSObj.GetSpecialFolder(2)
		'
		oDisp = "WindowsFolder /  " & oWinFldr & Chr(10) & "SystemFolder /  " & oSysFldr
		msgbox oDisp,0,"FileSystemObject"
		'
		set oFSObj = Nothing
		msgbox "Success",0,"End Code"
End Sub

Sub oFSObject()
	Dim oFSObj as Object
	Dim oDisp as String
	Dim oTmpFile as String
		set oFSObj = CreateObject("Scripting.FileSystemObject")
		'
		oTmpFile = oFSObj.GetTempName()
		'
		oDisp = "Temp File Name /  " & oTmpFile
		msgbox oDisp,0,"FileSystemObject"
		'
		set oFSObj = Nothing
		msgbox "Success",0,"End Code"
End Sub

Sub oFSObject()
	On Error Goto oBad
	Dim oFSObj as Object
	Dim oFile as String
		set oFSObj = CreateObject("Scripting.FileSystemObject")
		oFile = "C:\temp\Test_Access.xlsx"	
		If oFSObj.FileExists(oFile) then
			Dim oFileObj as Object
			Dim oName as String
			Dim oFileType as String
			Dim oSize as String
			'
			Dim oCreateObj as Object
			Dim oCreate as Date
			Dim oLastAccessObj as Object
			Dim oLastAccess as Date
			Dim oLastModifyObj as Object
			Dim oLastModify as Date
				'
				set oFileObj = oFSObj.GetFile(oFile)
				'
				oName = oFileObj.Name
				oFileType = oFileObj.Type
				oSize = oFileObj.Size
				'
				oCreateObj = oFileObj.DateCreated
				oCreate = CDate(oCreateObj.Value)					' oCreateObj.Value : Double Type
				'
				' LastModifiedされた時のAccess 日時  / CSV や Text Fileは DateLastModified と同じ 
				oLastAccessObj = oFileObj.DateLastAccessed
				oLastAccess = CDate(oLastAccessObj.Value)			' oLastAccessObj.Value : Double Type
				'
				oLastModifyObj = oFileObj.DateLastModified
				oLastModify = CDate(oLastModifyObj.Value)			' oLastModifyObj.Value  :  Double Type
				'
				oDisp = oFile & Chr$(10) & Chr$(10) & _
							"File Name :  " & oName & Chr$(10) & _
							"File Type :  " & oFileType & Chr$(10) & _
							"File Size  :  " & oSize & Chr$(10) & _
							"Created date of file  :  " & CStr(oCreate) & Chr$(10) & _
							"Last accesed date of file  :  " & CStr(oLastAccess) & Chr$(10) & _
							"Last modified date of file  :  " & CStr(oLastModify)
							'
				set oFileObj = Nothing
		else
			oDisp = oFile & Chr$(10) & " は存在しません"
		End If
		'
		set oFSObj = Nothing
		msgbox oDisp,0,"FileSystemObject"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

Sub oFSObject()
	On Error Goto oBad
	Dim oFSObj as Object
	Dim oFile as String
		set oFSObj = CreateObject("Scripting.FileSystemObject")
		oFile = "C:\temp\OOoTest.csv"	
		If oFSObj.FileExists(oFile) then
			Dim oFileObj as Object
				set oFileObj = oFSObj.GetFile(oFile)
				'
				If oFileObj.Attributes And 1 Then
					oDisp = oFileObj.Name & " ： 読み取り専用です。" & Chr$(10)
					'
					' 読み取り専用を解除
					oFileObj.Attributes = oFileObj.Attributes And &HFE
					If oFileObj.Attributes And 1 Then
						oDisp = oDisp & " → " & "  読み取り専用の解除に失敗しました。"
					else
						oDisp = oDisp & " → " & "  読み取り専用の解除しました。"
					End If
				else
					oDisp = oFileObj.Name & " ： 読み取り専用ではありません。"
				End If
		else
			oDisp = oFile & Chr$(10) & " は存在しません"
		End If
		'
		set oFSObj = Nothing
		msgbox oDisp,0,"FileSystemObject"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

Sub oFSObject()
	On Error Goto oBad
	Dim oFile1 as String, oFile2 as String, oFile3 as String, oFile4 as String, oFile5 as String
		oFile1 = "C:\temp\OOoTest.csv"	
		oFile2 = "C:\temp\OOoTest_Readonly.csv"
		oFile3 = "C:\temp\OOoTest_Hidden.csv"
		oFile4 = "C:\temp\OOoTest_Comp.7z"
		oFile5 = "C:\temp\Dummy.txt"
		'
		oDisp = ""
		oDisp = oDisp & oFile1 & "  →  " & FileAttr(oFile1) & Chr$(10)
		oDisp = oDisp & oFile2 & "  →  " & FileAttr(oFile2) & Chr$(10)
		oDisp = oDisp & oFile3 & "  →  " & FileAttr(oFile3) & Chr$(10)
		oDisp = oDisp & oFile4 & "  →  " & FileAttr(oFile4) & Chr$(10)
		oDisp = oDisp & oFile5 & "  →  " & FileAttr(oFile5) & Chr$(10)
		'
		msgbox oDisp,0,"FileSystemObject"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub
'
Function FileAttr( oFile as String) as String
	Dim oFSObj as Object
	Dim oFileObj as Object
		set oFSObj = CreateObject("Scripting.FileSystemObject")
		set oFileObj = oFSObj.GetFile(oFile)
		'
		select case oFileObj.Attributes
			case 0
				FileAttr = "Normal"
			case 1
				FileAttr = "ReadOnly"
			case 2
				FileAttr = "Hidden"
			case 1+2
				FileAttr = "ReadOnly + Hidden"
			case 4
				FileAttr = "System"
			case 1+4
				FileAttr = "ReadOnly + System"
			case 2+4
				FileAttr = "Hidden + System"
			case 1+2+4
				FileAttr = "ReadOnly + Hidden + System"
			case 8
				FileAttr = "Volume"
			case 1+8
				FileAttr = "ReadOnly + Volume"
			case 2+8
				FileAttr = "Hidden + Volume"
			case 4+8
				FileAttr = "System + Volume"
			case 1+2+8
				FileAttr = "ReadOnly + Hidden + Volume"
			case 1+4+8
				FileAttr = "ReadOnly + System + Volume"
			case 1+2+4+8
				FileAttr = "ReadOnly + Hidden + System + Volume"
			case 16
				FileAttr = "Directory"
			case 1+16
				FileAttr = "ReadOnly + Directory"
			case 2+16
				FileAttr = "Hidden + Directory"
			case 4+16
				FileAttr = "System + Directory"
			case 8+16
				FileAttr = "Volume + Directory"
			case 1+2+16
				FileAttr = "ReadOnly + Hidden + Directory"
			case 1+4+16
				FileAttr = "ReadOnly + System + Directory"
			case 1+8+16
				FileAttr = "ReadOnly + Volume + Directory"
			case 1+2+4+16
				FileAttr = "ReadOnly + Hidden + System + Directory"
			case 1+2+8+16
				FileAttr = "ReadOnly + Hidden + Volume + Directory"
			case 1+2+4+8+16
				
			case 32
				FileAttr = "Archive"
			case 1+32
				FileAttr = "ReadOnly + Archive"
			case 2+32
				FileAttr = "Hidden + Archive"
			case 4+32
				FileAttr = "System + Archive"
			case 8+32
				FileAttr = "Volume + Archive"
			case 16+32
				FileAttr = "Directory + Archive"
			case 1+2+32
				FileAttr = "ReadOnly + Hidden + Archive"
			case 1+4+32
				FileAttr = "ReadOnly + System + Archive"
			case 1+8+32
				FileAttr = "ReadOnly + Volume + Archive"
			case 1+16+32
				FileAttr = "ReadOnly + Directory + Archive"
			case 1+2+4+32
				FileAttr = "ReadOnly + Hidden + System + Archive"
			case 1+2+8+32
				FileAttr = "ReadOnly + Hidden + Volume + Archive"
			case 1+2+16+32
				FileAttr = "ReadOnly + Hidden + Directory + Archive"
			case 1+2+4+8+32
				FileAttr = "ReadOnly + Hidden + System + Volume + Archive"
			case 1+2+4+16+32
				FileAttr = "ReadOnly + Hidden + System + Directory + Archive"
			case 1+2+4+8+16+32
				FileAttr = "ReadOnly + Hidden + System + Volume + Directory + Archive"
			case 64
				FileAttr = "Alias"
			case 1+64
				FileAttr = "ReadOnly + Alias"
			case 2+64
				FileAttr = "Hidden + Alias"
			case 4+64
				FileAttr = "System + Alias"
			case 8+64
				FileAttr = "Volume + Alias"
			case 16+64
				FileAttr = "Directory + Alias"
			case 32+64
				FileAttr = "Archive + Alias"
			case 1+2+64
				FileAttr = "ReadOnly + Hidden + Alias"
			case 1+4+64
				FileAttr = "ReadOnly + System + Alias"
			case 1+8+64
				FileAttr = "ReadOnly + Volume + Alias"
			case 1+16+64
				FileAttr = "ReadOnly + Directory + Alias"
			case 1+32+64
				FileAttr = "ReadOnly + Archive + Alias"
			case 1+2+4+64
				FileAttr = "ReadOnly + Hidden + System + Alias"
			case 1+2+8+64
				FileAttr = "ReadOnly + Hidden + Volume + Alias"
			case 1+2+16+64
				FileAttr = "ReadOnly + Hidden + Directory + Alias"
			case 1+2+32+64
				FileAttr = "ReadOnly + Hidden + Archive + Alias"
			case 1+2+4+8+64
				FileAttr = "ReadOnly + Hidden + System + Volume + Alias"
			case 1+2+4+16+64
				FileAttr = "ReadOnly + Hidden + System + Directory + Alias"
			case 1+2+4+32+64
				FileAttr = "ReadOnly + Hidden + System + Archive + Alias"
			case 1+2+4+8+16+64
				FileAttr = "ReadOnly + Hidden + System + Volume + Directory + Alias"
			case 1+2+4+8+32+64
				FileAttr = "ReadOnly + Hidden + System + Volume + Archive + Alias"
			case 1+2+4+8+16+32+64
				FileAttr = "ReadOnly + Hidden + System + Volume + Directory + Archive + Alias"	
			case 128
				FileAttr = "Compress"
			case 1+128
				FileAttr = "ReadOnly + Compress"
			case 2+128
				FileAttr = "Hidden + Compress"
			case 4+128
				FileAttr = "System + Compress"
			case 8+128
				FileAttr = "Volume + Compress"
			case 16+128
				FileAttr = "Directory + Compress"
			case 32+128
				FileAttr = "Archive + Compress"
			case 64+128
				FileAttr = "Alias + Compress"
			case 1+2+128
				FileAttr = "ReadOnly + Hidden + Compress"
			case 1+4+128
				FileAttr = "ReadOnly + System + Compress"
			case 1+8+128
				FileAttr = "ReadOnly + Volume + Compress"
			case 1+16+128
				FileAttr = "ReadOnly + Directory + Compress"
			case 1+32+128
				FileAttr = "ReadOnly + Archive + Compress"
			case 1+64+128
				FileAttr = "ReadOnly + Alias + Compress"
			case 1+2+4+128
				FileAttr = "ReadOnly + Hidden + System + Compress"
			case 1+2+8+128
				FileAttr = "ReadOnly + Hidden + Volume + Compress"
			case 1+2+16+128
				FileAttr = "ReadOnly + Hidden + Directory + Compress"
			case 1+2+32+128
				FileAttr = "ReadOnly + Hidden + Archive + Compress"
			case 1+2+4+8+128
				FileAttr = "ReadOnly + Hidden + System + Volume + Compress"
			case 1+2+4+16+128
				FileAttr = "ReadOnly + Hidden + System + Directory + Compress"
			case 1+2+4+32+128
				FileAttr = "ReadOnly + Hidden + System + Archive + Compress"
			case 1+2+4+64+128
				FileAttr = "ReadOnly + Hidden + System + Alias + Compress"
			case 1+2+4+8+16+128
				FileAttr = "ReadOnly + Hidden + System + Volume + Directory + Compress"
			case 1+2+4+8+32+128
				FileAttr = "ReadOnly + Hidden + System + Volume + Archive + Compress"
			case 1+2+4+8+64+128
				FileAttr = "ReadOnly + Hidden + System + Volume + Alias + Compress"
			case 1+2+4+8+16+32+128
				FileAttr = "ReadOnly + Hidden + System + Volume + Directory + Archive + Compress"
			case 1+2+4+8+16+64+128
				FileAttr = "ReadOnly + Hidden + System + Volume + Directory + Alias + Compress"
			case 1+2+4+8+16+32+64+128
				FileAttr = "ReadOnly + Hidden + System + Volume + Directory + Archive + Alias + Compress"
		end select
		'
		set oFileObj = Nothing
		set oFSObj = Nothing
End Function

[ 正規表現 ]

Sub oVBSRegExp
	Dim oRegExp As Object 
		oRegExp = CreateObject("VBScript.RegExp") 
		' 対象文字列のObjectの設定
		oSchWord = "Office"
		oRegExp.Pattern = oSchWord		' 検索文字 
		oRegExp.Ignorecase = True	' 大文字小文字を区別を無視 ← Falseは区別を無視しない
		oRegExp.Global = True		' 正規表現を文字列内のすべての可能なマッチに対してテストすべきかどうか
	' 正規表現
	Dim oWords as String
		'
		oWords = "OpenOffice.org / LibreOffice"
		oRltSrch = oRegExp.Test(oWords) 
		'
		oDisp = "対象 => " & oWords & Chr$(10) & "検索文字 => " & oSchWord & Chr$(10) & "結果 => " & oRltSrch 
		msgbox oDisp,0,"VBS 正規表現"
		' 
		oRegExp = nothing 
End Sub 

Sub oVBSRegExp
	Dim oRegExp As Object 
		oRegExp = CreateObject("VBScript.RegExp") 
		' 対象文字列のObjectの設定
		oSchWord = "Office"
		oRegExp.Pattern = oSchWord	' 検索文字 
		oRegExp.Ignorecase = True	' 大文字小文字を区別を無視 ← Falseは区別を無視しない
		oRegExp.Global = True		' 正規表現を文字列内のすべての可能なマッチに対してテストすべきかどうか
	' 正規表現
	Dim oWords as String
		'
		oWords = "OpenOffice.org / LibreOffice"
		oRpleWord = "OFFICE"
		oRltSrch = oRegExp.Replace(oWords, oRpleWord) 
		'
		oDisp = "対象 => " & oWords & Chr$(10) & "検索文字 => " & oSchWord & Chr$(10) & "置換文字 => " & oRpleWord & Chr$(10) & "置換結果 => " & oRltSrch 
		msgbox oDisp,0,"VBS 正規表現"
		' 
		oRegExp = nothing 
End Sub 

Sub oVBSRegExp
	Dim oRegExp As Object 
		oRegExp = CreateObject("VBScript.RegExp") 
		' 対象文字列のObjectの設定
		oSchWord = "Office"
		oRegExp.Pattern = oSchWord	' 検索文字 
		oRegExp.Ignorecase = False	' 大文字小文字を区別を無視しない
		oRegExp.Global = True	' 正規表現を文字列内のすべての可能なマッチに対してテストすべきかどうか
	' 正規表現
	Dim oWords as String
		'
		oWords = "Openoffice.org / LibreOffice"
		oRltSrch = oRegExp.Execute(oWords) 
		'
		oDisp = "対象 => " & oWords & Chr$(10) & "検索文字 => " & oSchWord & Chr$(10) & "Matche数 => " & oRltSrch.count
		msgbox oDisp,0,"VBS 正規表現"
		' 
		oRegExp = nothing 
End Sub 

Sub oVBSRegExp
	Dim oRegExp As Object 
		oRegExp = CreateObject("VBScript.RegExp") 
		' 対象文字列のObjectの設定
		oSchWord = "[a-e]"
		oRegExp.Pattern = oSchWord	' 検索文字 
		oRegExp.Ignorecase = True	' 大文字小文字を区別を無視する
		oRegExp.Global = True
	' 正規表現
	Dim oWords as String
	Dim oRltSrch as Object
	Dim oCount as Integer
	Dim i as Long
	Dim oDisp as String
		'
		oWords = "E_OpenOffice.org / LibreOffice"
		oRltSrch = oRegExp.Execute(oWords) 
		'
		oCount = oRltSrch.count
		'
		oDisp = "検索対象： " & oWords & Chr$(10) & "正規表現： " & oSchWord & Chr$(10)
		'
		If oCount > 0 then
			oDisp = oDisp & Chr$(10) & "マッチした文字の数 = " & oCount & Chr$(10)
			for i = 0 to oCount-1
				oDisp = oDisp & Chr$(10) & "  (" & i+1 & ") " & "文字位置 =  " & oRltSrch.Item(i).FirstIndex & " /  一致した文字 =  " & oRltSrch.Item(i)
				oRltSrch = oRegExp.Execute(oWords) 	
			next
		else
			oDisp = oDisp & "マッチした文字はありません。"
		End If
		'
		msgbox oDisp,0,"VBS正規表現 LO6.2.4/Win10(64bit)"
		' 
		oRegExp = nothing 
End Sub
'
' 【注意事項】
' ①　FirstIndexはItem取得前に取得しないとエラー
'OK: oDisp = oDisp & Chr$(10) & "  (" & i+1 & ") " & "文字位置 =  " & oRltSrch.Item(i).FirstIndex & " /  一致した文字 =  " & oRltSrch.Item(i)	
'NG：oDisp = oDisp & Chr$(10) & "  (" & i+1 & ") " & "一致した文字 =  " & oRltSrch.Item(i) & " /  文字位置 =  " & oRltSrch.Item(i).FirstIndex
' 
' ②FirstIndexは一度、処置すると次はエラー。Loop4no外で2回同じ処置をしてもエラー。　回避方法は毎回、正規表現を実施。
'
'正規表現の参考サイト：Office TANAKA / 正規表現によるマッチング

[ WshShell ]

Sub oWshShell()
	On Error Goto oBad
	Dim oWSObj as Object
	Dim oCmdLine as String
		set oWSObj = CreateObject("WScript.Shell")
		oCmdLine = "notepad.exe"
		'
		' Execute natepad.exe
		oWSObj.Exec(oCmdLine)
		'
		set oWSObj = Nothing
		msgbox "Success",0,"WshShell"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

Sub oWshShell()
	On Error Goto oBad
	Dim oWSObj as Object
	Dim oCmdLine as String
	Dim oExecObj as Object
	Dim nk as Long
	Dim oLimit as Long
		set oWSObj = CreateObject("WScript.Shell")
		oCmdLine = "notepad.exe"
		'
		' Execute natepad.exe
		set oExecObj = oWSObj.Exec(oCmdLine)
		'
		nk = 0
		oLimit = 10000
		Do while oExecObj.Status = 0 and nk < oLimit
			wait 1000
			'
			nk = nk + 1
			if nk > oLimit then
				Exit Do
			end if
		Loop
		'
		if nk > oLimit then
			oDisp = "Loop制限です。"
		else
			oDisp = oCmdLine & " を終了しました。"
			set oExecObj = Nothing
		end if
		
		'
		set oWSObj = Nothing
		msgbox oDisp,0,"WshShell"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

Sub oWshShell()
	On Error Goto oBad
	Dim oWSObj as Object
	Dim oCmdLine as String
		set oWSObj = CreateObject("WScript.Shell")
		oCmdLine = "notepad.exe"
		'
		' Execute natepad.exe
		oWSObj.Run(oCmdLine,1, true)
		'
		set oWSObj = Nothing
		msgbox "Success",0,"WshShell"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub
'
' object.Run( cmd, [WinStyle], [WaitOnReturn] )
' → Execと異なり、単純に起動させるだけなので、起動中のApplicationのStatusは分らない。
'
' cmd : Execute File ← Full Pathがbetter
'
' [ WinStyle ]
'	1	:	Active	/ Normal Size	( Default )
'	2	:	Active  / Minimum Size
'	3	:	Active  / Maximum Size
'	4	:	Inactive/ Normal Size
'	5	:	Active  / Same Size as last time ( According to the application )
'	7	:	Inactive/ Minimum Size
'
' [ WaitOnReturn ]
'	true	:	Wait until the end

Sub oWshShell()
	On Error Goto oBad
	Dim oWSObj as Object
	Dim oCmdLine as String
	Dim oExecObj as Object
		set oWSObj = CreateObject("WScript.Shell")
		oCmdLine = "notepad.exe"
		'
		' Execute natepad.exe
		set oExecObj = oWSObj.Exec(oCmdLine)
		wait 3000			' wait 3 sec
		'
		' 強制終了
		oExecObj.Terminate
		set oExecObj = Nothing
		'
		set oWSObj = Nothing
		'
		oDisp = "Success"
		msgbox oDisp,0,"WshShell"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

Sub oWshShell()
	On Error Goto oBad
	Dim oWSObj as Object
	Dim oCmdLine as String
	Dim oExecObj as Object
	Dim nk as Long
	Dim oLimit as Long
		set oWSObj = CreateObject("WScript.Shell")
		oCmdLine = "notepad.exe"
		'
		' Execute natepad.exe
		set oExecObj = oWSObj.Exec(oCmdLine)
		'
		nk = 0
		oLimit = 10000
		Do while oExecObj.Status = 0 and nk < oLimit
			wait 1000
			'
			nk = nk + 1
			if nk > oLimit then
				Exit Do
			end if
		Loop
		'
		if nk > oLimit then
			oDisp = "Loop制限です。"
		else
			Dim oExitCode as Long
				oExitCode = oExecObj.ExitCode
				oDisp = oCmdLine & " を終了しました。" & Chr$(10) & _
							"  終了Status = " & oExitCode
				set oExecObj = Nothing
		end if
		'
		set oWSObj = Nothing
		msgbox oDisp,0,"WshShell"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

Sub oWshShell()
	On Error Goto oBad
	Dim oWSObj as Object
	Dim oCmdLine as String
	Dim oExecObj as Object
		set oWSObj = CreateObject("WScript.Shell")
		oCmdLine = "notepad.exe"
		'
		' Execute natepad.exe
		set oExecObj = oWSObj.Exec(oCmdLine)
		'
		msgbox "10 [sec] 以内に起動したProgramをActiveにして下さい。",0,"Active"
        wait 10000		' wait 10 [ sec ]
        oWSObj.AppActivate(oExecObj.ProcessID)
        oDisp = oCmdLine & " をActiveにしました。" & Chr$(10) & "Process ID = " & oExecObj.ProcessID
		'
		set oWSObj = Nothing
		msgbox oDisp,0,"WshShell"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

Sub oWshShell()
	On Error Goto oBad
	Dim oWSObj as Object
	Dim oCurFolder as String
		set oWSObj = CreateObject("WScript.Shell")
		'
		oCurFolder = oWSObj.CurrentDirectory
		oDisp = "[ Current Folder ] " & Chr$(10) & oCurFolder
		'
		set oWSObj = Nothing
		msgbox oDisp,0,"WshShell"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

Sub oWshShell()
	On Error Goto oBad
	Dim oWSObj as Object
	Dim oChgFolder as String
	Dim oCurFolder as String
		set oWSObj = CreateObject("WScript.Shell")
		'
		oChgFolder = "C:\Temp"
    	oWSObj.CurrentDirectory = oChgFolder
    	'
		oCurFolder = oWSObj.CurrentDirectory
		oDisp = "[ Current Folder ] " & Chr$(10) & oCurFolder
		'
		set oWSObj = Nothing
		msgbox oDisp,0,"WshShell"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

Sub oWshShell()
	On Error Goto oBad
	Dim oWSObj as Object
	Dim oTime as Long
	Dim oAns as Long
		set oWSObj = CreateObject("WScript.Shell")
		'
		oTime = 2
		oAns = oWSObj.Popup(oTime & " [sec]以内のClickして下さい。", oTime,  "時間内のClick？", vbOkCancel	 + vbQuestion)
		'
		' messagebox の FrameをClick ( OK Button や 「 × 」 以外 )
		select case oAns
			case -1
				oDisp = oTime & " sec が経過したのでMessageBoxをCloseしました。"
			case 1
				oDisp = oTime & " sec 以内にClickされました。"
		end select
		'
		set oWSObj = Nothing
		msgbox oDisp,0,"WshShell"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub
'
' [ 注意 ]
' OK Buttonしか反応しないことも多い。時間が長いとNG?
' Shell関数を用いてCommand Promptから実行した方が良さそう。
'
Sub VbsShell()
	Dim oVbsFile as String
		oVbsFile = "C:\temp\Test.vbs"
		Shell ("cmd /c " & oVbsFile)
End Sub
'
' ********** [ C:\temp\Test.vbs ] **********
Dim oWSObj, oTime, oAns
	Set oWSObj = WScript.CreateObject("WScript.Shell")
	'
	oTime = 2
	oAns = oWSObj.Popup(oTime & " [sec]以内のClickして下さい。", oTime,  "時間内のClick？", 1)
	'
	' messagebox の FrameをClick ( OK Button や 「 × 」 以外 )
	select case oAns
		case -1
			oDisp = oTime & " sec が経過したのでMessageBoxをCloseしました。"
		case 1
			oDisp = oTime & " sec 以内にClickされました。"
	end select
	'
	WScript.Echo oDisp
	set oWSObj = Nothing
' ********** [ C:\temp\Test.vbs ] **********
'
' Popup メソッドについては、MicroSoft公式Pageを参照の事。

Sub oWshShell()
	On Error Goto oBad
	Dim oWSObj as Object
	Dim oOsBit as String
	Dim oDisp as String
		set oWSObj = CreateObject("WScript.Shell")
		'
		oOsBit = oWSObj.Environment("Process").Item("PROCESSOR_ARCHITECTURE")
		oDisp = "[ CPU ]" & Chr$(10)
		Select case UCase(oOsBit)
			case "X86"
				oDisp = oDisp & oOsBit & " / 32Bit CPU "
			case "AMD64"
				oDisp = oDisp & oOsBit & " / 64Bit CPU "
			case "IA64"
				oDisp = oDisp & oOsBit & " / 64Bit CPU "
			case else
				oDisp = oDisp & " → Unknown CPU"
		End Select
		'
		set oWSObj = Nothing
		msgbox oDisp,0,"WshShell"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

Sub oWshShell()
	On Error Goto oBad
	Dim oWSObj as Object
	Dim oCmdLine as String
		set oWSObj = CreateObject("WScript.Shell")
		oCmdLine = "C:\temp\Movie\MovieTest.mp4"
		'
		' Execute natepad.exe
		oWSObj.Run(oCmdLine,1, true)
		'
		set oWSObj = Nothing
		msgbox "Success",0,"WshShell"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

Sub oWshShell()
	On Error Goto oBad
	Dim oWSObj as Object
	Dim oCmdLine as String
		set oWSObj = CreateObject("WScript.Shell")
		oCmdLine = "PowerShell"
		'
		' Execute PoweShell
		oWSObj.Exec(oCmdLine)	' or oWSObj.Run oCmdLine
		'
		set oWSObj = Nothing
		msgbox "Success",0,"WshShell"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub
'
' [ Note ]
' 上記はPowerShellを起動させるのみ。
' Reference Site
' ･あれあの備忘録/VBAからpowershellコマンドを実行する

' ･Pika's Home/VBScriptを使ってPowerShellスクリプトを管理者権限で実行する

' ･Excel VBAからPowerShellのScriptを起動する方法

' ･Windowsスクリプティング環境比較：PowerShell vs WSH / 3．スクリプト機能の比較（1）

[ Shell.Application ]

Sub oShell_App()
	On Error Goto oBad
	Dim oShellObj as Object
	Dim oPickFolder as String
	Dim oDefFolder as String
	Dim oDisp as String
	Dim oNote as String
		set oShellObj = CreateObject("Shell.Application")
		'
		oNote = "Folderを選択して下さい。" & Chr$(10) & "キャンセルは不可（Errorになります）"
		oDefFolder = "C:\Temp\test\"
		oPickFolder = oShellObj.BrowseForFolder(0, oNote, 0,oDefFolder)
		'
		oDisp = "選択されたFolderは" & Chr$(10) & Chr$(9) & oPickFolder & Chr$(10) & "  です。( Defualtは " & oDefFolder & " )"
		'
		set oShellObj = Nothing
		msgbox oDisp,0,"Shell.Application"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

Sub oShell_App()
	On Error Goto oBad
	Dim oShellObj as Object
	Dim oDisp as String
		set oShellObj = CreateObject("Shell.Application")
		'
		oShellObj.Explore "C:\Temp\test"
		wait 1000
		'
		oDisp = "Explorerが開きました。"
		'
		set oShellObj = Nothing
		msgbox oDisp,0,"Shell.Application"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

Sub oShell_App()
	On Error Goto oBad
	Dim oShellObj as Object
	Dim oDisp as String
		set oShellObj = CreateObject("Shell.Application")
		'
		oShellObj.FileRun
		'
		oDisp = "File名を指定して実行 Windowが開きました"
		'
		set oShellObj = Nothing
		msgbox oDisp,0,"Shell.Application"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

Sub oShell_App()
	On Error Goto oBad
	Dim oShellObj as Object
	Dim oDisp as String
		set oShellObj = CreateObject("Shell.Application")
		'
		oShellObj.FindFiles
		wait 1000
		'
		oDisp = "File と Folderの検索 Windowが開きました"
		'
		set oShellObj = Nothing
		msgbox oDisp,0,"Shell.Application"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

Sub oShell_App()
	On Error Goto oBad
	Dim oShellObj as Object
	Dim oDisp as String
		set oShellObj = CreateObject("Shell.Application")
		'
		oShellObj.Help
		wait 1000
		'
		oDisp = "WindowsのHelpが開きました"
		'
		set oShellObj = Nothing
		msgbox oDisp,0,"Shell.Application"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

Sub oShell_App()
	On Error Goto oBad
	Dim oShellObj as Object
	Dim oDisp as String
		set oShellObj = CreateObject("Shell.Application")
		'
		' 全てのWindowの最少化
		oShellObj.MinimizeAll
		wait 3000		' wait 3 [sec]
		'
		' 元のWindow Sizeに戻す( 最少化の解除 )
		oShellObj.UndoMinimizeAll
		'
		oDisp = "Window の最少化→元のSize"
		'
		set oShellObj = Nothing
		msgbox oDisp,0,"Shell.Application"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

Sub oShell_App()
	On Error Goto oBad
	Dim oShellObj as Object
	Dim oDisp as String
		set oShellObj = CreateObject("Shell.Application")
		'
		oShellObj.SetTime
		wait 2000		' wait 2 [sec]
		'
		oDisp = "日付と時刻の設定 Window が開きました。"
		'
		set oShellObj = Nothing
		msgbox oDisp,0,"Shell.Application"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

Sub oShell_App()
	On Error Goto oBad
	Dim oShellObj as Object
	Dim oDisp as String
		set oShellObj = CreateObject("Shell.Application")
		'
		oShellObj.ShutdownWindows
		wait 2000		' wait 2 [sec]
		'
		oDisp = "Windowｓ の Shutdown 画面が開きました。"
		'
		set oShellObj = Nothing
		msgbox oDisp,0,"Shell.Application"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

Sub oShell_App()
	On Error Goto oBad
	Dim oShellObj as Object
	Dim oDisp as String
		set oShellObj = CreateObject("Shell.Application")
		'
		' Current Windowの最少化
		oShellObj.TrayProperties
		wait 2000		' wait 2 [sec]
		'
		oDisp = "Taskbar と Start Menuの設定画面が開きました。"
		'
		set oShellObj = Nothing
		msgbox oDisp,0,"Shell.Application"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

Sub oWshShell()
	On Error Goto oBad
	Dim oWSObj as Object
	Dim oFolderObj as Object
	Dim oFileObj as Object
	Dim oFoderName as String
	Dim oChkFile as String
	Dim oFileName as String
		set oWSObj = CreateObject("Shell.Application")
		'
		oFoderName = "C:\temp"
		oFileName = "oTextMacro.txt"
		oChkFile = oFoderName & "\" & oFileName
		'
		oDisp = oChkFile & Chr$(10)
		if FileExists(oChkFile) then
			set oFolderObj = oWSObj.NameSpace(oFoderName)
			set oFileObj = oFolderObj.ParseName(oFileName)
			'
			Dim oName as String
			Dim oPath as String
			Dim oFileType as String
			Dim oParent as String
			Dim oSize as String
			Dim oMdfyDateObj as Object
			Dim oMdfyDate as Date
			Dim oHtml as Boolean
			Dim oIsFldFile as Boolean
			Dim oIsFolder as Boolean
			DIm oIsLink as Boolean
				oName = oFileObj.Name
				oPath = oFileObj.Path
				oFileType = oFileObj.Type
				oParent = oFileObj.Parent
				oSize = oFileObj.Size
				'
				oMdfyDateObj = oFileObj.ModifyDate
				oMdfyDate = CDate(oMdfyDateObj.Value)		' oMdfyDateObj.Value ← Double
				'
				oHtml = oFileObj.IsBrowsable
				oIsFldFile = oFileObj.IsFileSystem
				oIsFolder = oFileObj.IsFolder
				oIsLink = oFileObj.IsLink
				'
			oDisp = oDisp & Chr$(10) & "Name :  " & oName & Chr$(10) & _
						"Path :  " & oPath & Chr$(10) & _
						"File Type :  " & oFileType & Chr$(10) & _
						"Parent Folder :  " & oParent & Chr$(10) & _
						"File Size :  " & oSize & " [ Byte ]" & Chr$(10) & _
						"Modified Date :  " & CStr(oMdfyDate) & Chr$(10) & Chr$(10) & _
						"Html File ?  →  " & oHtml & Chr$(10) & _
						"Folder or File ?  →  " & oIsFldFile & Chr$(10) & _
						"Folder ?  →  " & oIsFolder & Chr$(10) & _
						"Link ?  →  " & oIsLink
			'
			set oFolderObj = Nothing
			set oFileObj = Nothing
		else
			oDisp = oDisp & "は存在しません。"
		end if
		'
		set oWSObj = Nothing
		msgbox oDisp,0,"WshShell"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

[ WScript.Network ]

Sub oWshShell()
	On Error Goto oBad
	Dim oWNetObj as Object
	Dim oDomain as String
	Dim oComputer as String
	Dim oUser as String
		set oWNetObj = CreateObject("WScript.Network")
		'
		oDomain = oWNetObj.UserDomain
		oComputer = oWNetObj.ComputerName
		oUser = oWNetObj.UserName
		'
		oDisp = "Domain =  " & oDomain & Chr$(10) & "Computer =  " & oComputer & Chr$(10) & "User Name =  " & oUser
		'
		oDisp = oDisp & Chr$(10) & Chr$(10) & "Seccess" & Chr$(10) & "[ LO5.1.4.2 on Windows10(32bit) ]"
		'
		set oWNetObj = Nothing
		msgbox oDisp,0,"Network"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub
'
' Windows管理者のためのWindows Script Host入門

Sub oWshShell()
	On Error Goto oBad
	Dim oWNetObj as Object
	Dim oDefautPrt as String
		set oWNetObj = CreateObject("WScript.Network")
		oDefautPrt = "Microsoft XPS Document Writer"
		REM oDefautPrt = "Fax"
		'
		oWNetObj.SetDefaultPrinter oDefautPrt
		oDisp = "Default Printerが" & Chr$(10) & oDefautPrt & Chr$(10) & "に設定されました。" 
		'
		set oWNetObj = Nothing
		msgbox oDisp,0,"Network"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub
'
' [ Note ]
' Default Printerの設定は出来るが、取得は出来ない。

Sub oWshShell()
	On Error Goto oBad
	Dim oWNetObj as Object
	Dim oPrinters as Object
	Dim oPort as String
	Dim oPrtName as String
		Set oWNetObj = CreateObject("WScript.Network")
		Set oPrinters = oWNetObj.EnumPrinterConnections
		'
		oDisp = "[ Printer List ]" & Chr$(10)
		for i = 0 to oPrinters.Count - 1 Step 2
			oPort = oPrinters.Item(i)					' Refer to Note
			oPrtName = oPrinters.Item(i+1)
    		oDisp = oDisp & oPort & " = " & oPrtName & Chr(10)
  		next i
  		'
  		oDisp = oDisp & Chr$(10) & "Seccess" & Chr$(10) & "[ LO5.1.4.2 on Windows10(32bit) ]"
		'
		Set oPrinters = Nothing
		Set oWNetObj = Nothing
		msgbox oDisp,0,"WScript.Network"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub
'
' [ Note ]
' Port値は正確では無い。正確な値を取得するにはレジストリをいじる必要がある模様。
'
' $$$ [ Reference site ] $$$
' 1) Blog site 「 513号室 」の保管庫(Excel：ActivePrinterへ設定するプリンタ名の列挙)より

' 2) Microsoft / TechNet " Find Printername and PrinterPort on VBScript "

[ WbemScripting.SWbemLocator ]

Sub oWbSt_SwLr()
	On Error Goto oBad
	Dim oLocatorObj as Object, oSrv as Object, oExeQuery as Object
	Dim oAppNum as Integer
	Dim oDisp as String
		set oLocatorObj = CreateObject("WbemScripting.SWbemLocator")
		set oSrv = oLocatorObj.ConnectServer 
		'
		set oExeQuery = oSrv.ExecQuery("Select * From Win32_Process") 
		oAppNum = oExeQuery.count
		oDisp = "起動中のProcess数 は" & Chr$(10) & oAppNum & " です。"
		'
		set oExeQuery = Nothing
		set oSrv = Nothing
		set oLocatorObj = Nothing
		'
		msgbox oDisp,0,"WbemScripting"
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

Sub oWbSt_SwLr()
	On Error Goto oBad
	Dim oLocatorObj as Object, oSrv as Object, oExeQuery as Object
	Dim oAppNum as Integer
	Dim oDisp as String
		set oLocatorObj = CreateObject("WbemScripting.SWbemLocator")
		set oSrv = oLocatorObj.ConnectServer 
		'
		set oExeQuery = oSrv.ExecQuery("Select * From Win32_Process Where Caption='notepad.EXE'")
		oAppNum = oExeQuery.count
		'
		If oAppNum = 0 then
			oDisp = "NotePadは起動していません。"
		else
			oDisp = "NotesPadが " & oAppNum & " つ起動しています。"
		End If
		'
		set oExeQuery = Nothing
		set oSrv = Nothing
		set oLocatorObj = Nothing
		'
		msgbox oDisp,0,"WbemScripting"
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub
'
' [ Note ]
' MS-Excel : EXCEL.EXE
' Internet Explore : iexplore.exe / 1つのIEでprocessは2つ
' Chrome : chrome.exe / 1つで複数のprocessを使っている。

[ Msxml2.ServerXMLHTTP / htmlfile ]

Option VBASupport 1		' For Eachを使う場合必須 
Sub oHttpHtmlFile()
	On Error Goto oBad
	Dim oHttpObj as Object
	Dim oHFObj as Object
	Dim oUrl as String
	Dim oTitle as String, oDisp as String
	Dim oDom
		set oHttpObj = CreateObject("Msxml2.ServerXMLHTTP")
		oUrl = "https://openoffice3.web.fc2.com/"
		oHttpObj.Open "GET", oUrl
		oHttpObj.send
    	Do While oHttpObj.readyState < 4
    		DoEvents
    	Loop
		oHFObj = CreateObject("htmlfile")
		oHFObj.write oHttpObj.responseText
		oTitle = oHFObj.Title
		oDisp = oTitle
		'oDom = oHFObj.getElementsByTagName("h1")(0).innerText	' 注：not Work
		For Each oDom in oHFObj.getElementsByTagName("h2")
			oDisp = oDisp & CHr$(13) & oDom.innerText
		Next
		'
		set oHFObj = Nothing
		set oHttpObj = Nothing
		msgbox oDisp,0,"LO7.0.1.2(x64)/Windows10"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox "Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message"
End Sub

[ MS-Office ]

{{ General }}

Sub oMsOffice()
	On Error Goto oBad
	Dim oExcelObj as Object
	Dim xlbook as Object
	Dim oDisp as String
		set oExcelObj = CreateObject("Excel.Application")
		set xlbook = oExcelObj.Workbooks.Add
		'
		oExcelObj.Visible = true
		'
		oDisp = "MS-Excel が起動しました"
		msgbox oDisp,0,"MS-Office"
		'
		xlbook.Close(false)
		oExcelObj.Quit
		'
		set xlbook = Nothing
		set oExcelObj = Nothing
		'
		oDisp = "Success"
		msgbox oDisp,0,"MS-Office"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

Sub oMsOffice()
	On Error Goto oBad
	Dim oWordObj as Object
	Dim oErrFlag as Integer
	Dim oDisp as String
		oErrFlag = 0
		set oWordObj = CreateObject("Word.Application")
		oErrFlag = 999
		'
		oWordObj.Visible = true
		'
		oDisp = "MS-Word が起動しました"
		msgbox oDisp,0,"MS-Office"
		'
		oWordObj.Quit(wdDoNotSaveChanges)
		set oWordObj = Nothing
		oErrFlag = 0
		'
		oDisp = "Success"
		msgbox oDisp,0,"MS-Office"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		'
		if oErrFlag = 999 then
			oWordObj.Quit(wdDoNotSaveChanges)
			set oWordObj = Nothing
		end if
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

Sub ExcelVBAMacro()
	Dim oExcelName as String
	Dim oExcelDoc as Object
	Dim oArgToExcel as String
	Dim oProp(0) as New com.sun.star.beans.PropertyValue
	Dim oSP as Object
	Dim oScript as Object
		'
		oExcelName = ConvertToUrl("c:\temp\Excel2007Test.xlsm")
		' Excel Document
		oProp(0).Name  = "Hidden"
  		oProp(0).Value = false
  		oExcelDoc = StarDesktop.loadComponentFromURL(oExcelName,"_default",0, oProp())
		'
  		oArgToExcel = "Execute From LibreOfice!!"
		'
 		oSP = oExcelDoc.ScriptProvider
 		' VBA Macro
		oScript = oSP.getScript("vnd.sun.star.script:VBAProject.Module1.ExcelMacro?language=Basic&location=document") 
		' Macro実行
		oScript.invoke( array(oArgToExcel),array(),array())	
		'
		' Excel Close
		oExcelDoc.close(true)
End Sub
'
' [ VBA ]
Sub ExcelMacro(Optional oArg As String)
    Dim oCellString As String
    Dim oDisp As String
        oCellString = Workbooks("Excel2007Test.xlsm").Worksheets("sheet1").Range("B2").Text
        oDisp = oCellString & Chr(10) & oArg
        MsgBox oDisp, 0, "Excel Macro"
End Sub

{{ Other }}

[ Internet Explorer ]

Sub oIE_VBS()
	On Error Goto oBad
	Dim oIEObj as Object
	Dim oUrl as String
		'
		set oIEObj = CreateObject("InternetExplorer.Application")
		oUrl = "http://oooug.jp/"
		'
    	oIEObj.Navigate( oUrl )
    	oIEObj.Visible = True
		'
		msgbox "Success",0,"IE"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

Sub oIE_VBS()
	On Error Goto oBad
	Dim oIEObj as Object
		'
		set oIEObj = CreateObject("InternetExplorer.Application")
		'
    	oIEObj.GoHome
    	oIEObj.Visible = True
		'
		msgbox "Success",0,"IE"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

Sub oIE_VBS()
	On Error Goto oBad
	Dim oIEObj as Object
		'
		set oIEObj = CreateObject("InternetExplorer.Application")
		'
    	oIEObj.GoHome
    	oIEObj.Visible = True
    	'
    	wait 1000
    	oIEObj.Quit
		'
		msgbox "Success",0,"IE"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

Sub oIE_VBS()
	On Error Goto oBad
	Dim oIEObj as Object
	Dim oUrl1 as String
	Dim oUrl2 as Variant
		'
		set oIEObj = CreateObject("InternetExplorer.Application")
		oUrl1 = "http://oooug.jp/"
		oUrl2 = "http://www.libreoffice.org/"
		'
		oIEObj.Visible = True
    	oIEObj.Navigate( oUrl1 )		' URL : String
    	' 
    	Dim nk as Long
    	Do until oIEObj.Busy = false or nk > 10000
    		wait 1000
    		nk = nk+1
    	Loop
    	'
    	if nk > 10000 then
    		msgbox("Loop制限です",0,"Loop Limit")
    		Exit Sub
    	end if
    	oIEObj.Navigate2( oUrl2 )		' URL : Variant
    	'
		'
		msgbox "Success",0,"IE"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

Sub oIE_VBS()
	On Error Goto oBad
	Dim oIEObj as Object
	Dim oUrl1 as String
	Dim oUrl2 as Variant
		'
		set oIEObj = CreateObject("InternetExplorer.Application")
		oUrl1 = "http://oooug.jp/"
		oUrl2 = "http://www.libreoffice.org/"
		'
		oIEObj.Visible = True
    	oIEObj.Navigate( oUrl1 )		' URL : String
    	' 
    	Dim nk as Long
    	Do until oIEObj.ReadyState = 4 or nk > 10000
    		wait 1000
    		nk = nk+1
    	Loop
    	'
    	if nk > 10000 then
    		msgbox("Loop制限です",0,"Loop Limit")
    		Exit Sub
    	end if
    	oIEObj.Navigate2( oUrl2 )		' URL : Variant
    	'
		'
		msgbox "Success",0,"IE"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub
'
' [ ReadyState ]
' 0	:	初期化中 / 前回のページデータのクリア時
' 1	:	表示データ読み込み中	　
' 2	:	表示データ読み込み完了	　
' 3	:	データの表示中	　
' 4	:	全てのデータが表示終了

Sub oIE_VBS()
	On Error Goto oBad
	Dim oIEObj as Object
	Dim oUrl1 as String
	Dim oUrl2 as Variant
		'
		set oIEObj = CreateObject("InternetExplorer.Application")
		oUrl1 = "http://oooug.jp/"
		oUrl2 = "http://www.libreoffice.org/"
		'
		oIEObj.Visible = True
    	oIEObj.Navigate( oUrl1 )		' URL : String
    	' 
    	Dim nk as Long
    	nk = 0
    	Do until oIEObj.Busy = false or nk > 10000
    		wait 1000
    		nk = nk+1
    	Loop
    	if nk > 10000 then
    		msgbox("Loop制限です",0,"Loop Limit")
    		Exit Sub
    	end if
    	'
    	oIEObj.Navigate2( oUrl2 )		' URL : Variant
    	nk = 0
    	Do until oIEObj.Busy = false or nk > 10000
    		wait 1000
    		nk = nk+1
    	Loop
    	if nk > 10000 then
    		msgbox("Loop制限です",0,"Loop Limit")
    		Exit Sub
    	end if
    	'
    	msgbox("Click → Go Back",0,"IE")
    	oIEObj.GoBack()
    	nk = 0
    	Do until oIEObj.Busy = false or nk > 10000
    		wait 1000
    		nk = nk+1
    	Loop
    	if nk > 10000 then
    		msgbox("Loop制限です",0,"Loop Limit")
    		Exit Sub
    	end if
    	'
    	msgbox("Click → Go Foward",0,"IE")
    	oIEObj.GoForward()
    	nk = 0
    	Do until oIEObj.Busy = false or nk > 10000
    		wait 1000
    		nk = nk+1
    	Loop
    	if nk > 10000 then
    		msgbox("Loop制限です",0,"Loop Limit")
    		Exit Sub
    	end if
    	'
    	' Bad URL → Stop
    	oIEObj.Navigate( "http://oooug.jpp/" )
    	oIEObj.Stop
		'
		msgbox "Success",0,"IE"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

Sub oIE_VBS()
	On Error Goto oBad
	Dim oIEObj as Object
		'
		set oIEObj = CreateObject("InternetExplorer.Application")
		'
    	oIEObj.GoHome
    	oIEObj.Visible = True
    	'
    	Dim nk as Long
    	nk = 0
    	Do until oIEObj.ReadyState = 4 or nk > 10000
    		wait 1000
    		nk = nk+1
    	Loop
    	'
    	if nk > 10000 then
    		msgbox("Loop制限です",0,"Loop Limit")
    		Exit Sub
    	end if
		'
	Dim oUrl as String
	Dim oDisp as String
		oUrl = oIEObj.LocationURL()
		'
		oDisp = "Current URL" & Chr$(10) & "→  " & oURL
		'
		msgbox oDisp,0,"IE"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

Sub oIE_VBS()
	On Error Goto oBad
	Dim oIEObj as Object
		'
		set oIEObj = CreateObject("InternetExplorer.Application")
		'
    	oIEObj.GoHome
    	oIEObj.Visible = True
    	'
    	Dim nk as Long
    	nk = 0
    	Do until oIEObj.ReadyState = 4 or nk > 10000
    		wait 1000
    		nk = nk+1
    	Loop
    	'
    	if nk > 10000 then
    		msgbox("Loop制限です",0,"Loop Limit")
    		Exit Sub
    	end if
		'
	Dim oUrlName as String
	Dim oDisp as String
		oUrlName = oIEObj.LocationName()
		'
		oDisp = "Title of Current Site" & Chr$(10) & "→  " & oUrlName
		'
		msgbox oDisp,0,"IE"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

Sub oIE_VBS()
	On Error Goto oBad
	Dim oIEObj as Object
	Dim oUrl as String
		'
		set oIEObj = CreateObject("InternetExplorer.Application")
		oUrl = "http://oooug.jp/"
		'
    	oIEObj.Navigate( oUrl )
    	oIEObj.Visible = True
		'
		wait 5000
		oIEObj.Refresh()			' Screen updates
		'
		msgbox "Success",0,"IE"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

Sub oIE_VBS()
	On Error Goto oBad
	Dim oIEObj as Object
	Dim oUrl as String
		'
		set oIEObj = CreateObject("InternetExplorer.Application")
		oUrl = "http://oooug.jp/"
		'
    	oIEObj.Navigate( oUrl )
    	oIEObj.Visible = True
		'
		oIEObj.Width = 400
		oIEObj.Height = 300
		oIEObj.Top = 100
		oIEObj.Left = 100
		'
		oIEObj.Resizable = False
		'
		msgbox "Success",0,"IE"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

Sub oIE_VBS()
	On Error Goto oBad
	Dim oIEObj as Object
	Dim oUrl as String
		'
		set oIEObj = CreateObject("InternetExplorer.Application")
		oUrl = "http://oooug.jp/"
		'
    	oIEObj.Navigate( oUrl )
    	oIEObj.Visible = True
    	'
		' Full Screen
		oIEObj.FullScreen  = true
		msgbox "Full Screen表示中です",0,"IE"
		'
		oIEObj.FullScreen  = false
		msgbox "Noraml 表示です",0,"IE"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

Sub oIE_VBS()
	On Error Goto oBad
	Dim oIEObj as Object
	Dim oUrl1 as String
		'
		set oIEObj = CreateObject("InternetExplorer.Application")
		oUrl1 = "http://oooug.jp/"
		'
		oIEObj.Visible = True
		oIEObj.Navigate( oUrl1 )		' URL : String
		'
		oIEObj.Width = 400
		oIEObj.Height = 200
		oIEObj.Top = 100
		oIEObj.Left = 100
		'
		Dim nk as Long
			Do until oIEObj.Busy = false or nk > 10000
				wait 1000
				nk = nk+1
			Loop
			'
			if nk > 10000 then
				msgbox("Loop制限です",0,"Loop Limit")
				Exit Sub
			end if
			'
		oIEObj.AddressBar = false		' .MenuBar 及び .ToolBar はIE9では関係無し
		oIEObj.Refresh()
		msgbox "Adress Bar非表示です。",0,"IE"
		'
		oIEObj.AddressBar = true
		oIEObj.Refresh()
		msgbox "Adress Bar表示です。",0,"IE"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

Sub oIE_VBS()
	On Error Goto oBad
	Dim oIEObj as Object
	Dim oUrl1 as String
		'
		set oIEObj = CreateObject("InternetExplorer.Application")
		oUrl1 = "http://www.google.co.jp/"
		'
		oIEObj.Visible = True
		oIEObj.Navigate( oUrl1 )		' URL : String
		'
		oIEObj.Width = 400
		oIEObj.Height = 200
		oIEObj.Top = 100
		oIEObj.Left = 100
		'
	Dim nk as Long
		Do until oIEObj.Busy = false or nk > 10000
			wait 1000
			nk = nk+1
		Loop
		'
		if nk > 10000 then
			msgbox("Loop制限です",0,"Loop Limit")
			Exit Sub
		end if
		'
	Dim oDisp as String
	Dim oSiteSrc as String
		oSiteSrc = oIEObj.Document.Body.innerText		' 取得を失敗するSiteもある / innerHtml 	は不可
		'
		oIEObj.Quit
		set oIEObj = Nothing
		'
		oDisp = "[ Site Source ]" & Chr$(10) & " *** [ " & oUrl1 & " ] ***" & Chr(10) & Chr$(10) & oSiteSrc
		msgbox oDisp,0,"Site Source"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

PowerShell

Sub oPowerShell()
	On Error Goto oBad
	Dim oWSObj as Object
	Dim oCmdLine as String
	
		Set oWSObj = CreateObject("WScript.Shell")
		oCmdLine = "powershell Compress-Archive -Path C:\Temp\Test\ -DestinationPath C:\Temp\Test1.zip -force"
		'
		Set oExec = oWSObj.Exec(oCmdLine)
		Do While oExec.Status = 0
			wait 100
		Loop
		Set oExec = Nothing
		Msgbox "圧縮完了",0,"LO7.1/Win10"
		
		oCmdLine = "powershell Expand-Archive -Path C:\Temp\Test1.zip -DestinationPath C:\Temp\Test1\ -force"
		Set oExec = oWSObj.Exec(oCmdLine)
		Do While oExec.Status = 0
			wait 100
		Loop
		
		Set oExec = Nothing
		Set oWSObj = Nothing
		Msgbox "解凍完了",0,"LO7.1/Win10"
		'
		Exit Sub
oBad:
	Dim oErLine As Integer
	Dim oErNum As Integer
	Dim oErMsg As String
		oErLine = Erl
		oErNum = Err
		oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

Sub oPowerShell()
	Dim oWSObj as Object
	Dim oCmdLine as String
	
		Set oWSObj = CreateObject("WScript.Shell")
		oCmdLine = "powershell -NoProfile -ExecutionPolicy Unrestricted C:\Temp\PS_test.ps1"
		'
		Set oExec = oWSObj.Exec(oCmdLine)
		Do While oExec.Status = 0
			wait 100
		Loop
		Set oExec = Nothing
		
		Msgbox "PowerSHell完了",0,"LO7.1/Win10"
End Sub
'
##### [ PS_test.ps1 ] #####

# アセンブリの読み込み
Add-Type -Assembly System.Windows.Forms
# メッセージボックスの表示
[System.Windows.Forms.MessageBox]::Show("LibreOffice Macro", "LO7.1")

##### [ PS_test.ps1 ] #####