If( xxx )Then
ElseIf( xxx )Then
Else
End If

For idx = 0 To 5 Step 1
Next
For Each tmp_value In value_array
  Exit For
Next

'+-- Do While 〜 Loop
Do While( xxx )
  Exit Do
Loop
'+-- While 〜 Wend
While
Wend
'+-- Do 〜 Loop While
Do
Loop While

'+-- 文字列表示
WScript.Echo "Hello World"

WScript.Quit

Dim a() '要素を指定しない
Redim a(3)
a = Array(4, 5, 6)
WScript.Echo UBound(a) 'サイズ=3
Redim Preserve a(10) 'Preserveで中身を消さない

WScript.Arguments.Item(0) '第１引数
WScript.Arguments.Item(1) '第２引数
WScript.Arguments.Count '引数の数
WScript.Arguments.Named.Exists("a") '"/a"が指定されているか

'+-- ”abcd"に”x”が含まれているか？
If(InStr("abcd", "x") = 0)Then WScript.Echo "含まれていません"

DateAdd("yyyy", -4, Now)  '4年前を取得
DateAdd("ww", -4, Now)    '4週前を取得
DateAdd("d", -4, Now)     '4日前を取得

Set excel = CreateObject("Excel.Application")
Set book  = excel.Workbooks.Open(excelfile)
Set book  = excel.Workbooks.Add '新規ブック
Set sheet = book.Sheets("Sheet1")
Set sheet = book.Sheets.Add '新規シート
Set sheet = book.Sheets.Add(, book.Sheets(book.Sheets.Count)) '新規シート:最後尾に追加
Set sheet = book.Sheets.Add(book.Sheets(1)) '新規シート:先頭に追加
'+-- セル値
sheet.Range("A1").Value = "値" '値を設定
a = sheet.Range("A1").Value   '値を取得
sheet.Range("A1").NumberFormatLocal = "@" 'セル書式を"文字列"にする
sheet.Cells(1,2).Value = "値" '値を設定(行列番号指定)
sheet.Range("A1").Interior.Color = vbRed '背景色を設定
sheet.Range("A1").Interior.ColorIndex = 24 '背景色を設定(ColorIndex指定)
sheet.Range("A1").Font.Color = vbBlue '文字色を設定
'+-- シート全体
sheet.Cells.NumberFormatLocal = "@" 'セル書式を"文字列"にする
sheet.Cells.Interior.Color = vbWhite '背景色を設定
'+-- セル操作
sheet.Range("B1:D1").Merge 'セル結合
sheet.Range("E:E").EntireColumn.AutoFit 'セルの自動調整
'+-- 罫線
With sheet.Range("B2:D2")
  .Borders(7).LineStyle = 1  '7:xlEdgeLeft,        1:xlContinuous
  .Borders(8).LineStyle = 1  '8:xlEdgeTop,         1:xlContinuous
  .Borders(9).LineStyle = 1  '9:xlEdgeBottom,      1:xlContinuous
  .Borders(10).LineStyle = 1 '10:xlEdgeRight,      1:xlContinuous
  .Borders(11).LineStyle = 1 '11:xlEdgeVertical,   1:xlContinuous
  .Borders(12).LineStyle = 1 '12:xlEdgeHorizontal, 1:xlContinuous
  .Borders(7).Weight = 2     '7:xlEdgeLeft,        2:xlThin
  .Borders(8).Weight = 2     '8:xlEdgeTop,         2:xlThin
  .Borders(9).Weight = 2     '9:xlEdgeBottom,      2:xlThin
  .Borders(10).Weight = 2    '10:xlEdgeRight,      2:xlThin
  .Borders(11).Weight = 2    '11:xlEdgeVertical,   2:xlThin
  .Borders(12).Weight = 2    '12:xlEdgeHorizontal, 2:xlThin
End With
'+-- オートシェイプ
sheet.Shapes("テキスト ボックス 1").TextEffect.Text = "値" '値を設定
'+-- ヘッダー/フッダー
sheet.PageSetup.LeftHeader   = "左ヘッダー"
sheet.PageSetup.CenterHeader = "中央ヘッダー"
sheet.PageSetup.RightHeader  = "右ヘッダー"
sheet.PageSetup.LeftFooter   = "左フッダー"
sheet.PageSetup.CenterFooter = "中央フッダー"
sheet.PageSetup.RightFooter  = "右フッダー"
'+-- 余白
sheet.PageSetup.LeftMargin   = 1.0
sheet.PageSetup.CenterMargin = 1.0
sheet.PageSetup.RightMargin  = 1.0
'+-- シートでループ
For Each sheet In book.Sheets
    WScript.Echo sheet.Name 'シート名を表示S
Next
'+-- シートでループ
For Each sheet In book.Sheets
  v = sheet.Cells(1,1).Value
Next
'+-- シートでループ(逆ループ)
For sheetIdx = book.Sheets.Count -1 To 1 Step -1
  'sheet.Delete 'シートを削除
Next
'+-- オートシェイプでループ
For Each shape In sheet.Shapes
  If(shape.type = 17)Then
      '17:msoTextBox テキストあり
      '6:msoGroup For Each shape2 In shape.TextFrame.Charactors.Texe
      '9:msoLine テキストなし
      '1:msoAutoShape 不明 If(shape.TextFrame2.HasText <> 0)Thenで判断
      WScript.Echo shape.TextEffect.Text
  End If
Next
'+-- 保存
book.Save
'+-- ブックを保存する
book.SaveAs pFilename
'+-- ブックを閉じる
book.Close
'+-- ブックを閉じる(保存確認なし)
book.Close False
'+-- 終了
excel.Quit
Set book = Nothing
Set excel = Nothing

Set excel = CreateObject("Excel.Application")
Set book  = excel.Workbooks.Open(excelfile)
Set sheet = book.Sheets("Sheet1")
sheet.Active
sheet.Range("A1").Select

Set FSO = CreateObject("Scripting.FileSystemObject")
'+-- ファイル情報
textfile = "C:¥script¥vbscript¥testfile.txt"
FSO.GetFileName(textfile) 'testfile.txt
FSO.GetBaseName(textfile) 'testfile
FSO.GetExtensionName(textfile) 'txt
FSO.GetParentFolderName(textfile) 'C:¥script¥vbscript
FSO.GetAbsolutePathName(textfile) 'C:¥script¥vbscript¥testfile.txt
'+-- スペシャルフォルダの取得
FSO.GetSpecialFolder(0) 'Windows Folder
FSO.GetSpecialFolder(1) 'System Folder
FSO.GetSpecialFolder(2) 'Temporary Folder
'+-- ファイル/フォルダの操作
FSO.DeleteFile srcFile 'ファイル削除
FSO.CopyFile srcFile, distFile 'ファイルコピー
FSO.MoveFile srcFile, distFile 'ファイル移動
FSO.CopyFolder srcFolder, distFolder 'フォルダコピー
FSO.CreateFolder("C:¥Folder1") 'フォルダ作成
If(FSO.FolderExists(folder))Then WScript.Echo "フォルダです"
'+-- ファイル情報2
Set thisFile = FSO.GetFile(file)
thisFile.DateCreated '作成時刻
thisFile.DateLastModified '最終更新時刻
thisFile.DateLastAccessed '最終アクセス時刻

Set FSO = CreateObject("Scripting.FileSystemObject")
CURRENT_FOLDER = FSO.GetParentFolderName(WScript.ScriptFullName)

Set oShell = CreateObject("WScript.Shell")
DESKTOP_FOLDER = oShell.SpecialFolders("desktop")

Set FSO = CreateObject("Scripting.FileSystemObject")
'+-- テキストファイルを読み込むために開く
Set objFile = FSO.openTextFile(pFilename)
Do While Not objFile.AtEndOfStream
    buffer = objFile.ReadLine
Loop
objFile.Close
Set objFile = Nothing

Set FSO = CreateObject("Scripting.FileSystemObject")
'+-- テキストファイルを読み込むために開く
Set objFile = FSO.openTextFile(pFilename)
textall = objFile.ReadAll
objFile.Close
Set objFile = Nothing

Set FSO = CreateObject("Scripting.FileSystemObject")
'+-- テキストファイルを書き込むために開く
Set textFile = FSO.openTextFile(pFilename, 2, True) '1:Read, 2:Write, 8:Append
textFile.WriteLine "Anything"
textFile.Close
Set textFile = Nothing

Set oShell = CreateObject("WScript.Shell")
oShell.Exec("cmd /c dir")
oShell.ExitCode

Set net = CreateObject("WScript.Network")
WScript.Echo net.ComputerName
WScript.Echo net.UserDomain
WScript.Echo net.UserName

Set hash = CreateObject("Scripting.Dictionary")
'+-- 追加
Call hash.Add("key1", "value1")
'+-- 有無と取得
If(hash.Exists("key1"))Then
  value = hash.Item("key1")
End If

Set oIE = CreateObject("InternetExplorer.Application")
oIE.Visible = True
oIE.Navigate2 "http://localhost/"
Set doc = oIE.Document
Set e1 = doc.getElementById("xxx") '単一
Set e2 = doc.getElementByName("xxx") 'これは配列に
'+-- テキスト
Set eText = doc.getElementById("xxx")
eText.Value = "値"
'+-- チェックボックス
Set eCheckBox = doc.getElementById("xxx")
eCheckBox.Checked = True
'+-- リンク
Set eLink = doc.getElementById("xxx")
eLink.click 'リンクをクリック
'+-- ボタン
Set eButton = doc.getElementById("xxx")
eButton.onClick 'ボタンをクリック

' --------------------------
' 表示されるまで待つ
' --------------------------
Sub WaitIE()
  Do While oIE.Busy
    WScript.Sleep 100
  Loop
End Sub

Set FSO = CreateObject("Scripting.FileSystemObject")
' --------------------------
' フォルダを再帰的に探索
' --------------------------
Sub DoSubFolder(pFolder)
  Set objFolder = FSO.GetFolder(pFolder)
  '+-- フォルダリスト
  For Each thisFolder In objFolder.SubFolders
    '+-- 再起呼び出し
    Call DoSubFolder(thisFolder)
  Next
  '+-- ファイルリスト
  For Each thisFile In objFolder.Files
    ext = LCase(FSO.GetExtensionName(thisFile))
    filename = FSO.GetBaseName(thisFile)
    'If(Left(filename,2) = "~$")Then
      'スルー(Excelのワークファイルのため)
    'ElseIf(ext = "xlsx" Or ext = "xls")Then
      Call execute(thisFile)
    'End If
  Next
End Sub

' --------------------------
' フォルダ選択
' --------------------------
Set oShell = CreateObject("WScript.Shell")
Function browseFolder()
  Set folder = oShell.browseForFoler(0, "フォルダ選択", 0)
  If(Not folder Is Nothing)Then
    Return folder.Items.Item.Path
  Else
    Return Nothing
  End If
End Function

' --------------------------
' 起動時に呼び出される関数
' --------------------------
Sub Window_OnLoad
End Sub

Set Locator = WScript.CreateObject("WbemScripting.SWbemLocator")
Set Service = Locator.ConnectServer

'+-- Win7 64bitではとりあえず大丈夫だった。
Set printers = Service.ExecQuery("Select * From Win32_Printer Where Default='True'")

For Each printer In printers
	MsgBox printer.Caption
Next

Set printers = Nothing
Set Locator = Nothing
Set Service = Nothing

Set FSO = CreateObject("Scripting.FileSystemObject")
Set excel = CreateObject("Excel.Application")
Set book  = excel.Workbooks.Open(excelfile)
Set sheet = book.Sheets("Sheet1")
sheet.Range("B" & idx).Select
image = "C:¥script¥test.jpg"
If FSO.FileExists(image) Then
  '+-- アクティブセルの左上を基準に画像を貼り付け
  sheet.Range("C5").Select
  sheet.Pictures.Insert image
End If
book.Save
book.Close
excel.Quit

Set FSO = CreateObject("Scripting.FileSystemObject")
Set excel = CreateObject("Excel.Application")
Set book  = excel.Workbooks.Open(excelfile)
Set sheet = book.Sheets("Sheet1")
'+--
Set myRange = sheet.Range("B2:D10")
For Each myShape In sheet.Shapes
  '+-- セル範囲(myRange)にオートシェイプが入っていれば削除
  If Not excel.Intersect(sheet.Range(myShape.TopLeftCell, myShape.BottmRightCell), myRange) Is Nothing Then
    myShape.Delete
  End If
Next
book.Save
book.Close
excel.Quit

Set oShell = CreateObject("WScript.Shell")
' --------------------------
' フォルダを再起的に探索
'  0:成功,1:失敗,2:警告,4:情報
' --------------------------
Sub WriteEventLog(pType, pMessage)
  Call oShell.LogEvent(pType, pMessage)
End Sub

Set conn    = CreateObject("adodb.connection")
Set catalog = CreateObject("adox.catalog")

'+-- MDBファイルにOLEDBドライバで接続する
With conn
 .Provider = "Microsoft.Jet.OLEDB.4.0"
 .ConnectionString = "C:¥script¥abcde.mdb"
 .Open
End With

'+-- カタログにDBへ接続中のオブジェクトを設定
catalog.ActiveConnection = conn

'+-- テーブルのループ
For Each table In catalog.Tables

  If table.Type = "TABLE" Then 'TABLE/VIEW/LINK/ACCESS TABLE/SYSTEM TABLE/PASS-THROUGH/
    WScript.Echo "=== TABLE === " & table.Name
    For each column in table.Columns
      WScript.Echo "--- Field ---"
      'column.name 'フィールド名
      'column.type 'データ型を数字で表す
      WScript.Echo column.name & ":" & column.type

      WScript.Echo "--- Properties ---"
      For Each obj in column.Properties
        'obj.Name   'フィールドのプロパティ名
        'obj.Value  '現在の設定
        WScript.Echo obj.Name & ":" & obj.Value
      Next
    Next 'column
  End If 'table
Next 'table

Set column = Nothing
Set table = Nothing
Set catalog = Nothing
Set conn = Nothing

Set oDOM = CreateObject("MSXML2.DomDocument")
oDOM.ansync = False
ret = oDOM.Load(file)
If ret Then WScript.Echo "XMLファイルです"

' --------------------------
' フォルダ作成
' --------------------------
Sub CreateFolder(pFolder)
  parentFolder = FSO.GetParentFolderName(pFolder)
  If Not FSO.FolderExists(parentFolder) Then
    CreateFolder(parentFolder)
  End If

  If Not FSO.FolderExists(pFolder)Then
    FSO.CreateFolder(pFolder)
  End If
End Sub

' --------------------------
' オートシェイプからテキスト取得
' @param pSheet シートオプジェクト
' @param pShapeName オートシェイプにつけられた名称
' @return String 取得したテキスト(エラー時は空文字)
' --------------------------
Function GetShapeText(pSheet, pShapeName)
On Error Resume Next
  pValue = ""
  pValue = pSheet.Shapes(pShapeName).TextEffect.Text
  GetShapeText = pValue
End Function

Set REG = CreateObject("VBScript.RegExp")
REG.pattern = "^¥d(_d{1,2})*" '[9_9_9]/[9_99_99]/[9_9_9_9]...
REG.IgnoreCase = False

str = "1_1_11_あげほげ.xlsx"
Set match = REG.execute(str)
For Each m In match
  WScript.Echo m.Value 'ヒットした部分が取得できる 1_1_11
Next

[設定値]
&8 : フォントを8ptにする
&"フォント名" :　指定されたフォントに設定する
&A : シート名
&F : ファイル名
&P : ページ番号
改行 : CR(Chr(13), vbCr)
[設定例]
&"ＭＳ ゴシック,標準"&10&P -> フォント[ＭＳ ゴシック]10ptで"ページ番号"を印字する

' --------------------------
' 改行コードを文字に置換
'   CRLF=%改行(CRLF)%, CR=%改行(CR)%, LF=%改行(LF)%
' @param pValue 文字列(改行コードあり)
' @return String 文字列(改行コードを文字に変換)
' --------------------------
Function ConvEnterCode2String(ByVal pValue)
  If(pValue = "")Then
    ConvEnterCode2String = ""
  ElseIf(InStr(pValue, vbCrLf) > 0)Then
    ConvEnterCode2String = Replace(pValue, vbCrLf, "%改行(CRLF)%")
  ElseIf(InStr(pValue, vbCr) > 0)Then
    ConvEnterCode2String = Replace(pValue, vbCr, "%改行(CR)%")
  ElseIf(InStr(pValue, vbLf) > 0)Then
    ConvEnterCode2String = Replace(pValue, vbLf, "%改行(LF)%")
  Else
    ConvEnterCode2String = pValue
  End If
End Function

Set conn = CreateObject("ADODB.Connection")
'+-- Oracle ODBCプロバイダ
connectionString = "Driver={Oracle in OraDB12Home1};" _
                 & "DBQ=host:port/SID;" _
                 & "UID=xxx;" _
                 & "PWD=xxx;"
conn.Open(connectionString)
SQL = "SELECT SYSDATE FROM DUAL;"
Set rs = conn.Execute(SQL)

'文字化けする場合は以下で環境変数NLS_LANGを適切に設定する
'Set oShell = CreateObject("WScript.Shell")
'Set env = oShell.Environment("USER")
'env.Item("NLS_LANG") = "Japanese_Japan.UTF8"
'env.Item("NLS_LANG") = "Japanese_Japan.JA16SJIS"
'env.Item("NLS_LANG") = "Japanese_Japan.JA16SJISTILDE"
'env.Item("NLS_LANG") = "Japanese_Japan.JA16EUC"
'env.Item("NLS_LANG") = "Japanese_Japan.JA16EUCTILDE"

'+-- カラム名
For columnIdx = 0 To rs.Fields.Count -1
  rs(columnIdx).Name
Next

'+-- データを取得
Do Until rs.Eof
  For columnIdx = 0 To rs.Fields.Count -1
    rs(columnIdx).Value
  Next
  rs.MoveNext
Loop

rs.Close
Set rs = Nothing

conn.Close
Set conn = Nothing

Function ConvComlumnNumber2Alpha(ByVal pColNumber)
   a = pColNumber
   work = ""
   Do While pColNumber > 0
      a = Int((pColNumber - 1) / 26)
      b = (pColNumber - 1) Mod 26
      work = Chr(b + 65) & work
      pColNumber = a
   Loop
   ConvComlumnNumber2Alpha = work
End Function

str = "aa bb cc ( dd, ee, ff) ggg"
idx1 = InStr(str, "(")
idx2 = InStr(str, ")")

'結果
str1 = Left(str, idx1-1) '[aa bb cc ]
str2 = Mid(str, idx1+1, idx2-idx1-1)) '[ dd, ee, ff]
str3 = Mid(str, idx2+1) '[ ggg]

  Set excel = CreateObject("Excel.Application")
  Set book  = excel.Workbooks.Open(excelfile)
  '+-- シートでループ
  For Each sheet In book.Worksheets
    sheetname = sheet.Name
  Next
  book.Close False
  excel.Quit

url = "xxxxx"
'Set objHttp = CreateObject("MSXML2.XMLHTTP") ' TLS1.2に非対応
Set objHttp = CreateObject("MSXML2.ServerXMLHTTP")

Call objHttp.Open("GET", url, False)
objHttp.Send

Do While objHttp.ReadyState < 4
    DoEvents
Loop

If Not objHttp.Status = 200 Then
  'Error
  WScript.Quit
End If

'text = objHttp.responseText 'Shift_JIS(MS932)用
text = StrConv(objHttp.responseBody, vbUnicode)

Set objHttp = Nothing

Function GetTimeStampString
	GetTimeStampString = Replace(Replace(Replace(Now, "/",""),":","")," ","")
End Function

Set FSO = CreateObject("Scripting.FileSystemObject")
Set oShell = CreateObject("WScript.Shell")
CURRENT_FOLDER = FSO.GetParentFolderName(WScript.ScriptFullName)
DESKTOP_FOLDER = oShell.SpecialFolders("desktop")

'実行部
Sub Execute(ByVal pFile)
  Call Process
End Sub

'処理部
Sub Process()
End Sub

Function GetTimeStampString
	GetTimeStampString = Replace(Replace(Replace(Now, "/",""),":","")," ","")
End Function

'メイン
Sub Main
On Error Resume Next
	
	'+-- 引数チェック
	If WScript.Arguments.Count > 0 Then
    WScript.Echo "引数がありません"
    WScript.Quit
  Else
    param1 = WScript.Arguments.Item(0)
  End If
	
	'+-- フォルダorファイル
	If Not FSO.FileExists(param1) Then
    Call DoSubFolder(param1)
	ElseIf Not FSO.FileExists(param1) Then
  	Call Execute(param1)
	End If

End Sub

Call Main()
WScript.Quit

Function IsDuplicateSheetName(ByVal pSheetName, ByRef pBook)
	
	For Each sheet In pBook.Sheets
		If pSheetName = sheet.Name Then
			IsDuplicateSheetName = True
			Exit Function
		End If
	Next
	
	IsDuplicateSheetName = False
	
End Function

Function ZeroPadding(ByVal pValue, ByVal pDigit)
  ZeroPadding = Right(String(pDigit, "0") & pValue, pDigit)
End Function

Set oShell = WScript.CreateObject("WScript.Shell")
'Popup("メッセージ",秒,"タイトル",ボタン)
'[ボタン]vbOKOnly/vbOKCancel/vbAbortRetryIgnore/vbYesNoCancel/vbYesNo/vbRetryCancel
'[アイコン]なし/vbCritical/vbQuestion/vbExclamation/vbInformation
'[フォーカス]vbDefaultButton1/vbDefaultButton2/vbDefaultButton3
'[戻り値]vbOK/vbCancel/vbAbort/vbRetry/vbIgnore/vbYes/vbNo/時間切れ(-1)
timeout = 5
notimeout = 0
ret = oShell.Popup("中止する場合は「キャンセル」を押してください。", timeout, "処理を実行しますか？", vbOKCancel+vbQuestion)

Select Case ret
Case vbOK
  oShell.Popup "実行しました。(これは自動的に閉じません)", notimeout,, vbInformation
Case vbCancel
  oShell.Popup "キャンセルしました。", timeout,, vbInformation
Case -1
  oShell.Popup "自動的に実行しました。", timeout,, vbInformation
End Select

b = 1
c = 2
a = "b + c"
Execute "MsgBox " & a '3

Set FSO = CreateObject("Scripting.FileSystemObject")
Private Sub Include(ByVal pFileName)
  inc = FSO.OpenTextFile(pFileName, 1, False).ReadAll()
  Execute inc
End Sub

Const StdIn = 0
Const StdOut = 1
Const StdErr = 2
Dim isUnicode As Boolean = True //Optional False=ASCII Default:False
Set textStream = FSO.GetStandardStream(StdOut, isUnicode)