'指定したファイルのコピー「Copy_File.vbs」

Option Explicit'変数の強制

Call File_Copy("G:\Microsoft-Excel.zip","F:\Microsoft-Excel.zip")

Sub File_Copy(Moto,Saki)

Dim objFS
On Error Resume Next
' FileSystemObject オブジェクトを生成する
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")
' ファイルをコピーする(ファイルを上書き保存する:True)
objFS.CopyFile Moto,Saki, False

If Err Then
WScript.Echo "ファイルはコピーできませんでした : " & Saki
Else
WScript.Echo "ファイルをコピーしました"
End If
Set objFS = Nothing'オブジェクトの解放
Exit Sub
End Sub

-------------------------------------------------------------------------------

'指定したフォルダのコピー「Copy_Folder.vbs」
Option Explicit'変数の強制
Call Folder_Copy("G:\WSH","F:\WSH")
Sub Folder_Copy(Moto,Saki)
Dim objFS
' FileSystemObject オブジェクトを生成する
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")
' フォルダをコピーする(ファイルを上書き保存:True)
objFS.CopyFolder Moto,Saki, True
Set objFS = Nothing'オブジェクトの解放
Exit Sub
End Sub

-------------------------------------------------------------------------------

指定したファイルの削除「File_Delete.vbs」
Option Explicit'変数の強制
Call File_Delete("F:\Backup\クエリ1.xlsx")
Sub File_Delete(PTH)
Dim objFS
On Error Resume Next
' FileSystemObject オブジェクトを生成する
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")
' ファイルを削除する
objFS.DeleteFile PTH

' 削除できたかどうかメッセージを表示する
If Err Then
WScript.Echo "ファイルは削除できませんでした"
Else
WScript.Echo "ファイルを削除しました"
End If
Set objFS = Nothing'オブジェクトの解放
Exit Sub
End Sub

-------------------------------------------------------------------------------

'「File_Pikker.vbs」
'VBSから直接、ファイル選択ダイアログを利用する方法は、基本的に無い。
'Windowsおパソコンには、基本的にエクセルがインストールされている前提で、エクセルのGetOpenFilenameを利用して、ファイル選択ダイアログを利用する。
Option Explicit'変数の強制
Msgbox File_Pikker'選択したファイルのフルパスを表示する。
Function File_Pikker()
'WHSファイルピッカー（Excel利用）
Dim Excel, PTH_0
Set Excel = CreateObject("Excel.Application")'エクセルのオブジェクトを作成
PTH_0 = Excel.GetOpenFilename("総てのファイル,*.*",1,"ファイルを選択して下さい","開く",false)'エクセルオブジェクトのGetOpenFilenameメソッドを設定
If PTH_0 <> False Then
File_Pikker = PTH_0
Else
File_Pikker = "ファイルが選択されていません！"
'WScript.Quit
End If
Set Excel = Nothing'オブジェクトの解放
Exit Function
End Function

-------------------------------------------------------------------------------

'指定したフォルダの削除「Folder_Delete.vbs」
Option Explicit'変数の強制
Call File_Delete("F:\WSH")
Sub File_Delete(PTH)
Dim objFS
On Error Resume Next
' FileSystemObject オブジェクトを生成する
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")
' フォルダを削除する
objFS.DeleteFolder PTH, True

' 削除できたかどうかメッセージを表示する
If Err Then
WScript.Echo "フォルダは削除できませんでした"
Else
WScript.Echo "フォルダを削除しました"
End If
Set objFS = Nothing'オブジェクトの解放
Exit Sub
End Sub

-------------------------------------------------------------------------------

'フォルダに含まれるすべてのファイル名(フルパスを取得)を取得するDir関数「GetFie_Files_Name.vbs」
Option Explicit'変数の強制
CAll GetFie_Files_Name("O:\ファイル情報を取得")
Sub GetFie_Files_Name(PTH)
Dim objFS, objFolder, colFiles, objFile
Dim strFilesName,Check_PTH
'末尾の￥チェック
If Right(PTH,1) <> "\" Then
Check_PTH = PTH & "\"
Else
Check_PTH = PTH
End If
'FileSystemObject オブジェクトを生成する
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")
'カレントフォルダ（ツールの置かれたフォルダ）のFolderオブジェクトを取得する
'Set objFolder = objFS.GetFolder(".")
'任意のフォルダを指定してファイル名を取得
Set objFolder = objFS.GetFolder(Check_PTH & ".")
'フォルダに含まれるすべてのファイルを取得する
Set colFiles = objFolder.Files
' 個々のファイル名(フルパスを取得)を文字列に追加する
strFilesName = ""
'colFilesの中のファイル名が無くなるまで続行
For Each objFile in colFiles
'フルパスを取得
strFilesName = strFilesName & Check_PTH & objFile.Name & vbCRLF
Next
'結果を表示する
WScript.Echo strFilesName
Set colFiles = Nothing'オブジェクトの解放
Set objFolder = Nothing'オブジェクトの解放
Set objFS = Nothing'オブジェクトの解放
Exit Sub
End Sub

-------------------------------------------------------------------------------

'サブフォルダを取得する「Get_Sub_Folders.vbs」
Option Explicit'変数の強制
Call Get_Sub_Folders("F:")
Sub Get_Sub_Folders(PTH)
Dim objFS, objFolder, colSubFolders, objSubFolder
Dim strFoldersName,Check_PTH
'末尾の￥チェック
If Right(PTH,1) <> "\" Then
Check_PTH = PTH & "\"
Else
Check_PTH = PTH
End If
' FileSystemObject オブジェクトを生成する
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")
' Folder オブジェクトを取得する
Set objFolder = objFS.GetFolder(Check_PTH)
' サブフォルダの Folders コレクションを取得する
Set colSubFolders = objFolder.SubFolders
' すべてのサブフォルダ名(フルパス)をstrFoldersNameに入れる
strFoldersName = ""
For Each objSubFolder in colSubFolders
strFoldersName = strFoldersName & Check_PTH & objSubFolder.Name & vbCRLF
'ここに「Get_Files_Name.vbs」のロジックを起動させれば、総てのファイル名を取得できる。
Next
WScript.Echo strFoldersName
Set colSubFolders = Nothing'オブジェクトの解放
Set colSubFolders = Nothing'オブジェクトの解放
Set objFS = Nothing'オブジェクトの解放
End Sub

-------------------------------------------------------------------------------

'タイムスタンプの取得「Get_Time_Stamp.vbs」

Option Explicit'変数の強制
Msgbox Get_Time_Stamp
Function Get_Time_Stamp()
'タイムスタンプの取得
Dim Get_Now,Get_TS,Get_Month,Get_Day,Get_Hour,Get_Minute,Get_Sec
Get_Now = Now()'現在の日付と時刻を取得

'月、日、時、分、秒の桁数が1ケタの場合、頭に0を付加
If Len(Month(Get_Now)) = 1 Then
Get_Month = "0" & Month(Get_Now)
Else
Get_Month = Month(Get_Now)
End If
If Len(Day(Get_Now)) = 1 Then
Get_Day = "0" & Day(Get_Now)
Else
Get_Day = Day(Get_Now)
End If
If Len(Hour(Get_Now)) = 1 Then
Get_Hour = "0" & Hour(Get_Now)
Else
Get_Hour = Hour(Get_Now)
End If
If Len(Minute(Get_Now)) = 1 Then
Get_Minute = "0" & Minute(Get_Now)
Else
Get_Minute = Minute(Get_Now)
End If
If Len(Second(Get_Now)) = 1 Then
Get_Sec = "0" & Second(Get_Now)
Else
Get_Sec = Second(Get_Now)
End If
Get_TS = Year(Get_Now) & Get_Month & Get_Day & Get_Hour & Get_Minute & Get_Sec'タイムスタンプの作成
Get_Time_Stamp = Get_TS'タイムスタンプを返す
Exit Function
End Function

-------------------------------------------------------------------------------

Call Get_WeekDat
Sub Get_WeekDat()
'現在の日付を取得し、その日の曜日を取得して環境変数「errorlevel」に現在の曜日を数値で格納

'作成者：
'作成日：2014/08/14
'変更日：2014/08/14

WScript.Quit(WeekDay(Date))
Exit Sub
End Sub

-------------------------------------------------------------------------------

'指定したファイルの移動「Move_File.vbs」

Option Explicit'変数の強制
Call File_Move("G:\Microsoft-Excel.zip","F:\Microsoft-Excel.zip")
Sub File_Move(Moto,Saki)
Dim objFS
On Error Resume Next
' FileSystemObject オブジェクトを生成する
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")
' ファイルを移動する
objFS.MoveFile Moto,Saki
If Err Then
WScript.Echo "ファイルは移動できませんでした : " & Saki
Else
WScript.Echo "ファイルを移動しました"
End If
Set objFS = Nothing'オブジェクトの解放
Exit Sub
End Sub

-------------------------------------------------------------------------------

'指定したフォルダの移動「Move_Folder.vbs」
'書き込み出来ないエラーが出る！(800A0046　書き込みできません。　Microsoft VBScript 実行時エラー)
Option Explicit'変数の強制
Call File_Move("G:\WSH","F:\WSH")
Sub File_Move(Moto,Saki)
Dim objFS
On Error Resume Next
' FileSystemObject オブジェクトを生成する
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")
' フォルダを移動する
objFS.MoveFolder Moto,Saki

If Err Then
WScript.Echo "フォルダは移動できませんでした : " & Saki
Else
WScript.Echo "フォルダを移動しました"
End If
Set objFS = Nothing'オブジェクトの解放
Exit Sub
End Sub

-------------------------------------------------------------------------------

'指定したフォルダの移動（応用）「Move_Folder_応用.vbs」
'「CopyFolder」でフォルダをコピーして、「DeleteFolder」で元フォルダを削除する。
Option Explicit'変数の強制
Dim Moto_Folder,Saki_Folder
Moto_Folder = "F:\WSH"
Saki_Folder = "G:\WSH"
Call Move_Folder(Moto_Folder,Saki_Folder)
Sub Move_Folder(Moto_Folder,Saki_Folder)
Call Folder_Copy(Moto_Folder,Saki_Folder)'フォルダをコピー
Call File_Delete(Moto_Folder)'元フォルダを削除
End Sub
Sub Folder_Copy(Moto,Saki)
Dim objFS
' FileSystemObject オブジェクトを生成する
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")
' フォルダをコピーする(ファイルを上書き保存:True)
objFS.CopyFolder Moto,Saki, True
Set objFS = Nothing'オブジェクトの解放
Exit Sub
End Sub

Sub File_Delete(PTH)
Dim objFS
On Error Resume Next
' FileSystemObject オブジェクトを生成する
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")
' フォルダを削除する
objFS.DeleteFolder PTH, True

' 削除できたかどうかメッセージを表示する
If Err Then
WScript.Echo "元フォルダは削除できませんでした"
Else
WScript.Echo "元フォルダを削除しました"
End If
Set objFS = Nothing'オブジェクトの解放
Exit Sub
End Sub

-------------------------------------------------------------------------------

'作成者：瀧澤禮好
'作成日：2017/03/29
'変更日：2017/03/29

'テキストファイルを1行づつ読み込んで処理を行う場合のベースパターン
'

Dim StrStr,PTH,pthc,FL_Name '文字列変数の宣言
Dim cnt 'カウンター変数の宣言

PTH = InputBox("フルパスを入力してください！", "正規表現_検索ツール:インプットフルパス入力", "D:\@work\WSH関連\")'インプットデータのフルパスの入力
IF PTH = "" Then
Msgbox "処理は中断されました！",16,"正規表現_検索ツール:インプットフルパス入力"
WScript.Quit'スクリプトの終了
End IF
pthc = Right(PTH,1)'入力したフルパスの末尾チェック

IF pthc <> "\" Then'末尾が￥でない場合のみ
PTH = PTH & "\"'￥を付加する
End IF

FL_Name = InputBox("テキストファイル名を入力してください！", "正規表現_検索ツール:ファイル名入力", "Get_TXT_Last_Line20170329154153.txt")'インプットデータのファイル名の入力
IF FL_Name = "" Then
Msgbox "処理は中断されました！",16,"正規表現_検索ツール:ファイル名入力"
WScript.Quit'スクリプトの終了
End IF
FL_Name = PTH & FL_Name 'フルパス,ファイル名の結合

'ファイルシステムオブジェクトの生成
Set objFso = CreateObject("Scripting.FileSystemObject")
'読み込み専用モードでのテキストファイルのオープン
Set objFile = objFso.OpenTextFile(FL_Name, 1, False)

'一行づつ読み込む繰り返し処理
If Err.Number > 0 Then
Msgbox "Open Error"
Else
cnt = 1 'カウンターの初期化

'最後の行になるまで繰り返す
Do Until objFile.AtEndOfStream
If cnt = 1 Then 'カウンター1だったらそのまま文字列変数に格納
StrStr = objFile.ReadLine & vbCrLf
Else 'カウンターが1以外の場合、前の格納したデータに追加して格納
StrStr = StrStr & objFile.ReadLine & vbCrLf
End If
cnt = cnt + 1 'カウンターに1をインクリメント
Loop
End If
'メモリーの解放
objFile.Close
Set objFile = Nothing
Set objFso = Nothing
Msgbox StrStr '結果の表示
WScript.Quit'スクリプトの終了

-------------------------------------------------------------------------------

'作成者：瀧澤禮好
'作成日：2017/03/29
'変更日：2017/03/29
'シャットダウンスクリプト

Dim DD 'Win32Shutdown 引数
DD = InputBox("0:ログオフ、1:シャットダウン、2:再起動、4:強制ログオフ、5:強制シャットダウン、6:強制再起動、8:電源オフ、12:強制電源オフ", "処理を選択してください！", "8")
If DD = "" Then 'キャンセルしたら
WScript.Quit 'スクリプトの終了
End If
Set objSystemSet = GetObject("winmgmts:{impersonationLevel=impersonate,(Shutdown)}").InstancesOf("Win32_OperatingSystem")
For Each objSystem In objSystemSet
objSystem.Win32Shutdown DD
Next
'Win32Shutdown 引数
'0 ログオフ
'1 シャットダウン
'2 再起動
'4 強制ログオフ
'5 強制シャットダウン
'6 強制再起動
'8 電源オフ
'12 強制電源オフ

-------------------------------------------------------------------------------

Option Explicit

Dim Str_Item
Str_Item = "あいうえお"
Call Put_CipBord(Str_Item)
Public Sub Put_CipBord(Str_Item)
'クリップボードに出力(末尾に改が入る)
Dim CMD,CNT

CMD = "CMD /c ""echo " & Str_Item & "| clip"""
CreateObject("WScript.Shell").Run CMD, 0
Exit Sub
End Sub

-------------------------------------------------------------------------------

'追加書き込みモードでテキストファイルの作成「テキストファイルに出力.vbs」
Option Explicit'変数の強制
Call Out_Put_Txt("C:\Noriyoshi_Data\WSH","Test_0","000-0000-00000")
'PTH・・・出力先フォルダ、F_Name・・・出力ファイル名、Item・・・出力データ（文字列）
Sub Out_Put_Txt(PTH,F_Name,Item)
Dim objFS,File_Name
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")'ファイルシステムオブジェクトのクリエイト
'末尾の￥チェック
If Right(PTH,1) <> "\" Then
File_Name = PTH & "\" & F_Name & ".txt"
Else
File_Name = PTH & F_Name & ".txt"
End If
'追加書き込みモードでテキストファイルの作成
Set objFS = objFS.OpenTextFile(File_Name,8,True)
'「1」は読み出し専用モード、「2」は新規作成モード、「8」は追加書き込みモード 「True」指定でファイルが無い場合に新規作成
objFS.WriteLine Item
objFS.Close
Set objFS = Nothing'オブジェクトの解放
Exit Sub
End Sub

-------------------------------------------------------------------------------

'テキストファイルのオープン及び変数への文字列格納「テキストファイルのオープン及び変数への文字列格納.vbs」
Option Explicit'変数の強制宣言
Msgbox Get_Txc_File_To_String("C:\Noriyoshi_Data\Log_List\Deleat_txt_20190601091344BackUp.txt")
Function Get_Txc_File_To_String(PTH)
Dim objFS,objTS,Str_Sample
'テキストファイルのオープン及び変数への格納
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")'ファイルシステムオブジェクトのクリエイト
Set objTS = objFS.OpenTextFile(PTH, 1) 'ファイルを開く
Str_Sample = objTS.REadAll'テキストファイルを総て読み込み変数（Str_Sample）へ転記（※文字が無いテキスト（空）ファイルではエラーになる）
Get_Txc_File_To_String = Str_Sample
Set objTS = Nothing'オブジェクトの解放
Set objFS = Nothing'オブジェクトの解放
Exit Function
End Function

-------------------------------------------------------------------------------

'指定したフォルダの有無を確認「ドライブの有無確認.vbs」
Option Explicit'変数の強制
Msgbox Drive_Exists("O")
Function Drive_Exists(PTH)
Dim objFS
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")'ファイルシステムオブジェクトのクリエイト
'指定したフォルダの有無を確認
IF objFS.DriveExists(PTH) = False Then
Drive_Exists = "無"
Else
Drive_Exists = "有"
END IF
Set objFS = Nothing'オブジェクトの解放
Exit Function
End Function

-------------------------------------------------------------------------------

'指定したファイルの有無を確認「ファイルの有無確認.vbs」
Option Explicit'変数の強制
Msgbox File_Exists("C:\Noriyoshi_Data\WSH\File_Pikker.vbs")
Function File_Exists(PTH)
Dim objFS
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")'ファイルシステムオブジェクトのクリエイト
'指定したファイルの有無を確認
IF objFS.FileExists(PTH) = False Then
File_Exists = "無"
Else
File_Exists = "有"
END IF
Set objFS = Nothing'オブジェクトの解放
Exit Function
End Function

-------------------------------------------------------------------------------

'指定したフォルダの有無を確認「フォルダの有無確認.vbs」
Option Explicit'変数の強制
Msgbox Folder_Exists("C:\Noriyoshi_Data\WSH")
Function Folder_Exists(PTH)
Dim objFS
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")'ファイルシステムオブジェクトのクリエイト
'指定したフォルダの有無を確認
IF objFS.FolderExists(PTH) = False Then
Folder_Exists = "無"
Else
Folder_Exists = "有"
END IF
Set objFS = Nothing'オブジェクトの解放
Exit Function
End Function

-------------------------------------------------------------------------------

Option Explicit

Dim S_Item
S_Item = InputBox("検索する文字列を入力してください！", "検索文字列の入力", "姦淫")'インプットデータのファイル名の入力
Call Get_Str_Item(File_Pikker,S_Item)


Sub Get_Str_Item(PTH,Str_Item)
'指定したテキストファイルから、任意の文字列を検索して、抽出した文字列の存在する行番号と行の文字列を表示。
Dim objFS, objTS
Dim strLine, iColumn, iColumn_N
' FileSystemObject オブジェクトを生成する
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")
' TextStream オブジェクトを取得する
Set objTS = objFS.OpenTextFile(PTH, 1)
' ファイルの末尾に達するまで1行ずつ読み込む
Do Until objTS.AtEndOfStream
strLine = objTS.ReadLine
iColumn = InStr(strLine, Str_Item)

If iColumn > 0 Then
' 現在の行位置と文字列の先頭位置を表示し、繰り返しを抜ける
If objTS.AtEndOfStream = True Then' ファイルの末尾に達したかを確認
iColumn_N = objTS.Line ' 取得した文字列の行位置を表示（ファイルの末尾）
Else
iColumn_N = objTS.Line -1' 取得した文字列の行位置を表示
End If
Msgbox iColumn_N & "行目で抽出"
'strLine = strLine & objTS.Line & " " & objTS.ReadLine & vbCRLF
strLine = strLine
WScript.Echo strLine
'Exit Do'最初に見つけたモノのみなら繰り返しを抜ける。
End If
Loop

objTS.Close
Msgbox "終了！"
End Sub

Function File_Pikker()

'WHSファイルピッカー（Excel利用）
Dim Excel, PTH_0
Set Excel = CreateObject("Excel.Application")'エクセルのオブジェクトを作成
PTH_0 = Excel.GetOpenFilename("総てのファイル,*.*",1,"ファイルを選択して下さい","開く",false)'エクセルオブジェクトのGetOpenFilenameメソッドを設定
If PTH_0 <> False Then
File_Pikker = PTH_0
Else
File_Pikker = "ファイルが選択されていません！"
'WScript.Quit
End If
Set Excel = Nothing'オブジェクトの解放
Exit Function
End Function

-------------------------------------------------------------------------------

'指定したフォルダの削除・コピー「指定したフォルダの削除・コピー.vbs」

Option Explicit'変数の強制
Dim In_Folder,Out_Folder
In_Folder = "O:\ファイル情報を取得"
Out_Folder = "F:\ファイル情報を取得2"
Call File_Delete(Out_Folder)
Call Folder_Copy(In_Folder,Out_Folder)
Sub Folder_Copy(Moto,Saki)
Dim objFS
' FileSystemObject オブジェクトを生成する
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")
' フォルダをコピーする(ファイルを上書き保存:True)
objFS.CopyFolder Moto,Saki, True
Set objFS = Nothing'オブジェクトの解放
Msgbox "コピー完了！"
Exit Sub
End Sub

Sub File_Delete(PTH)
Dim objFS
On Error Resume Next
' FileSystemObject オブジェクトを生成する
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")
' フォルダを削除する
objFS.DeleteFolder PTH, True

' 削除できたかどうかメッセージを表示する
If Err Then
WScript.Echo "フォルダは削除できませんでした"
Else
WScript.Echo "フォルダを削除しました"
End If
Set objFS = Nothing'オブジェクトの解放
Exit Sub
End Sub

-------------------------------------------------------------------------------

'正規表現「正規表現.vbs」
Option Explicit'変数の強制
Call Grep_Matches("\d*[0-9]","0123456789あいうえおかきくけこさしすせそたちつてとなにぬねの")
Sub Grep_Matches(Input_Reg_Str,Str_Sample)
Dim Reg_Pattern,Col_Matches,Count_No,Obj_Match,Str_Str

Set Reg_Pattern = new RegExp'「Reg_Pattern」変数に「new RegExp」オブジェクトを設定

Reg_Pattern.Pattern = Input_Reg_Str'正規表現のパターン文字列を入力
Reg_Pattern.Global = True'全体を検索プロパティ
'プロパティ：
'Global ⇒Trueの場合、全体を検索。Falseの場合、最初に一致したものだけ検索。
'IgnoreCase⇒Trueの場合、大文字と小文字を区別しない。Falseの場合、大文字と小文字を区別する。
'Pattern ⇒正規表現のパターンを格納

Set Col_Matches = Reg_Pattern.Execute(Str_Sample)'文字列検索メソッド
'メソッド：
'Execute ⇒正規表現に基づいて文字列を検索。検索対象になる文字列を引数に指定。
'Replace ⇒正規表現に基づいて文字列を検索して、発見した文字列を置換する。検索対象の文字列、置換後の文字列を引数として指定。
'Test ⇒正規表現に一致する部分があるかを調査する。一致する部分があればTrue、無ければFalseを返す。

Count_No = 0'カウンタ初期化

For Each Obj_Match in Col_Matches'「Col_Matches」の中の「Obj_Match」が無くなるまで繰り返す
'WScript.Echo Obj_Match.Value'発見した「Obj_Match」をメッセージ表示
Str_Str = Str_Str & vbCrLf & Obj_Match.Value
Count_No = Count_No + 1'カウント処理
Next
Msgbox Str_Str'この文字列をテキストに出力
Set Reg_Pattern = Nothing'オブジェクトの解放
Set Col_Matches = Nothing'オブジェクトの解放
Msgbox Count_No & "件抽出しました！",64,"正規表現_検索ツール"
Exit Sub
End Sub

-------------------------------------------------------------------------------

'文字列を連結する
Option Explicit'変数の強制

Dim Moji_Retsu1,Moji_Retsu2,Moji_Retsu3,Moji_Retsu4,Moji_Retsu5,Renketsu_Retsu

Moji_Retsu1 = "あ"
Moji_Retsu2 = "い"
Moji_Retsu3 = "う"
Moji_Retsu4 = "え"
Moji_Retsu5 = Get_Time_Stamp

Renketsu_Retsu = Moji_Retsu1 & Moji_Retsu2 & Moji_Retsu3 & Moji_Retsu4 & Moji_Retsu5

MsgBox Renketsu_Retsu

Function Get_Time_Stamp()
'タイムスタンプの取得
Dim Get_Now,Get_TS,Get_Month,Get_Day,Get_Hour,Get_Minute,Get_Sec
Get_Now = Now()'現在の日付と時刻を取得

'月、日、時、分、秒の桁数が1ケタの場合、頭に0を付加
If Len(Month(Get_Now)) = 1 Then
Get_Month = "0" & Month(Get_Now)
Else
Get_Month = Month(Get_Now)
End If
If Len(Day(Get_Now)) = 1 Then
Get_Day = "0" & Day(Get_Now)
Else
Get_Day = Day(Get_Now)
End If
If Len(Hour(Get_Now)) = 1 Then
Get_Hour = "0" & Hour(Get_Now)
Else
Get_Hour = Hour(Get_Now)
End If
If Len(Minute(Get_Now)) = 1 Then
Get_Minute = "0" & Minute(Get_Now)
Else
Get_Minute = Minute(Get_Now)
End If
If Len(Second(Get_Now)) = 1 Then
Get_Sec = "0" & Second(Get_Now)
Else
Get_Sec = Second(Get_Now)
End If
Get_TS = Year(Get_Now) & Get_Month & Get_Day & Get_Hour & Get_Minute & Get_Sec'タイムスタンプの作成
Get_Time_Stamp = Get_TS'タイムスタンプを返す
Exit Function
End Function

-------------------------------------------------------------------------------

Dim objXL
Set objXL = WScript.GetObject("F:\Backup\クエリ1.xlsx")
objXL.Application.Visible = True
objXL.Parent.Windows("F:\Backup\クエリ1.xlsx").Visible = True
Set objXL = Nothing'オブジェクトの解放
-------------------------------------------------------------------------------

'objFile.DateLastModified

'txtファイルのみコピーする
'変数の宣言を強制します
Option Explicit

'変数objGetFileを宣言します
Dim objGetFile,strFileName,NW,TS,PTH,PTH_O,Copy_File

NW = Now()
TS = Year(NW) & Month(NW) & Day(NW) & Hour(NW) & Minute(NW) & Second(NW)
PTH = InputBox("検査するフォルダを入力してください！","Dir_All_File_Get","C:\法人番号検索DB\Webコントロール_Access")
PTH_O = InputBox("出力フォルダを入力してください！","Dir_All_File_Get","Z:\法人番号検索DB\DB登録用_HTMLデータ\2013")
'PTH_O = InputBox("出力フォルダを入力してください！","Dir_All_File_Get","M:\頭X")
'objGetFileにGetFileNameクラスのオブジェクトをセットします
Set objGetFile = New GetFileName

'GetFileNameクラスのExecute()メソッドを実行します
Call objGetFile.Execute(PTH)
MsgBox "終了しました！"

'GetFileNameクラスを宣言します
Class GetFileName
'Execute()メソッドを宣言します
Public Sub Execute(ByVal strFolder)
'変数objFsoを宣言します
Dim objFso
'objFsoにScripting.FileSystemObjectのオブジェクトをセットします
Set objFso = WScript.CreateObject("Scripting.FileSystemObject")
'変数objFolderを宣言します
Dim objFolder
'objFolderにSAMPLEフォルダーのオブジェクトをセットします
Set objFolder = objFso.GetFolder(PTH)
'ShowFileName()メソッドを実行します
Call ShowFileName(objFolder)
End Sub
'ShowFileName()メソッドを宣言します
Private Sub ShowFileName(ByRef objFolder)
'変数objFileを宣言します
Dim objFile,Size_In
'パラメータに指定されたフォルダーのオブジェクトの中のファイルを１件ずつ取得します
For Each objFile In objFolder.Files
'取得したファイルの名称を表示します
'Call MsgBox(objFile.Name)
strFileName = objFolder & "\" & objFile.Name '& vbCrLf
Copy_File = PTH_O & "\" & objFile.Name
strFileName = Replace(strFileName,":\\",":\")
Size_In = Check_Size(strFileName)
'Msgbox File_Date
'Msgbox Date_Today
If Size_In > 20000 Then
'txtファイルのみ取得
If Right(strFileName,4) = ".txt" Then
Call File_Copy(strFileName,Copy_File)
Call File_Delete(strFileName)
End If
End If
Next
'変数objSubFolderを宣言します
Dim objSubFolder
'パラメータに指定されたフォルダーのオブジェクトの中のサブフォルダーを１件ずつ取得します
For Each objSubFolder In objFolder.SubFolders
'ShowFileName()メソッドを再帰呼び出しします
Call ShowFileName(objSubFolder)
Next
End Sub
End Class
Function Check_Size(File_In)
Dim objFS,objFile,Size_In
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")'ファイルシステムオブジェクトのクリエイト
Set objFile = objFS.GetFile(File_In)
Size_In = objFile.Size
Check_Size = Size_In
Exit Function
End Function
Function Comp_Date(File_In)
Dim objFS,objFile,Date_In
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")'ファイルシステムオブジェクトのクリエイト
Set objFile = objFS.GetFile(File_In)
Date_In = objFile.DateLastModified
Comp_Date = Left(Date_In,10)
Exit Function
End Function
Sub For_Tex_File()
Dim objFS,objTS,OUT_PTH
OUT_PTH = Get_Current_Directory & TS & "_Get_File.txt"
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")'ファイルシステムオブジェクトのクリエイト
If OUT_PTH = "" Then
WScript.Quit
End If
Set objTS = objFS.OpenTextFile(OUT_PTH,8,True)
objTS.WriteLine strFileName
objTS.Close
Set objTS = Nothing
End Sub
Function Get_Current_Directory()
Dim objWshell
Set objWshell = CreateObject("WScript.Shell")
Get_Current_Directory = objWshell.CurrentDirectory & "\"
Set objWshell = Nothing
End Function
'Call File_Copy("G:\Microsoft-Excel.zip","F:\Microsoft-Excel.zip")
Sub File_Copy(Moto,Saki)
Dim objFS
On Error Resume Next
' FileSystemObject オブジェクトを生成する
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")
' ファイルをコピーする(ファイルを上書き保存する:True)
objFS.CopyFile Moto,Saki, False

Set objFS = Nothing'オブジェクトの解放
Exit Sub
End Sub
Sub File_Delete(PTH)
Dim objFS
On Error Resume Next
' FileSystemObject オブジェクトを生成する
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")
' ファイルを削除する
objFS.DeleteFile PTH

Set objFS = Nothing'オブジェクトの解放
Exit Sub
End Sub
--------------------------------------------------------------------------------
'指定したフォルダのコピー「Copy_Folder.vbs」
Option Explicit'変数の強制
Dim CRD
Call Current_D
Call File_Delete(CRD & "\DATA\EmEditorPro")
Call File_Delete(CRD & "\DATA\『ガールズ＆パンツァー もっとらぶらぶ作戦です！』WEB出張版")
Call Folder_Copy("C:\Noriyoshi_Data\EmEditorPro",CRD & "\DATA\EmEditorPro")
Call Folder_Copy("G:\『ガールズ＆パンツァー もっとらぶらぶ作戦です！』WEB出張版",CRD & "\DATA\『ガールズ＆パンツァー もっとらぶらぶ作戦です！』WEB出張版")
Msgbox CRD & " OK"
Sub Folder_Copy(Moto,Saki)
Dim objFS
' FileSystemObject オブジェクトを生成する
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")
' フォルダをコピーする(ファイルを上書き保存:True)
objFS.CopyFolder Moto,Saki, True
Set objFS = Nothing'オブジェクトの解放
Exit Sub
End Sub
Sub File_Delete(PTH)
Dim objFS
On Error Resume Next
' FileSystemObject オブジェクトを生成する
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")
' フォルダを削除する
objFS.DeleteFolder PTH, True

' 削除できたかどうかメッセージを表示する
If Err Then
WScript.Echo "フォルダは削除できませんでした"
Else
'WScript.Echo "フォルダを削除しました"
End If
Set objFS = Nothing'オブジェクトの解放
Exit Sub
End Sub
Sub Current_D()
Dim FSO,INS_No
set FSO = createObject("Scripting.FileSystemObject")
CRD = FSO.getParentFolderName(WScript.ScriptFullName)
INS_No = InStr(CRD, ":")
CRD = Left(CRD,INS_No)
End Sub
--------------------------------------------------------------------------------
'変数の宣言を強制します
Option Explicit

'変数objGetFileを宣言します
Dim objGetFile,strFileName,NW,TS,PTH

NW = Now()
TS = Year(NW) & Month(NW) & Day(NW) & Hour(NW) & Minute(NW) & Second(NW)
PTH = InputBox("検査するフォルダを入力してください！","Dir_All_File_Get","C:\法人番号検索DB\")

'objGetFileにGetFileNameクラスのオブジェクトをセットします
Set objGetFile = New GetFileName

'GetFileNameクラスのExecute()メソッドを実行します
Call objGetFile.Execute(PTH)
MsgBox "法人番号検索DB 終了しました！"

'GetFileNameクラスを宣言します
Class GetFileName
'Execute()メソッドを宣言します
Public Sub Execute(ByVal strFolder)
'変数objFsoを宣言します
Dim objFso
'objFsoにScripting.FileSystemObjectのオブジェクトをセットします
Set objFso = WScript.CreateObject("Scripting.FileSystemObject")
'変数objFolderを宣言します
Dim objFolder
'objFolderにSAMPLEフォルダーのオブジェクトをセットします
Set objFolder = objFso.GetFolder(PTH)
'ShowFileName()メソッドを実行します
Call ShowFileName(objFolder)
End Sub
'ShowFileName()メソッドを宣言します
Private Sub ShowFileName(ByRef objFolder)
'変数objFileを宣言します
Dim objFile
'パラメータに指定されたフォルダーのオブジェクトの中のファイルを１件ずつ取得します
For Each objFile In objFolder.Files
'取得したファイルの名称を表示します
'Call MsgBox(objFile.Name)
strFileName = objFolder & "\" & objFile.Name '& vbCrLf
strFileName = Replace(strFileName,":\\",":\")
Call For_Tex_File
Next
'変数objSubFolderを宣言します
Dim objSubFolder
'パラメータに指定されたフォルダーのオブジェクトの中のサブフォルダーを１件ずつ取得します
For Each objSubFolder In objFolder.SubFolders
'ShowFileName()メソッドを再帰呼び出しします
Call ShowFileName(objSubFolder)
Next
End Sub
End Class
Sub For_Tex_File()
Dim objFS,objTS,OUT_PTH
On Error Resume Next
OUT_PTH = Get_Current_Directory & TS & "_Get_File.txt"
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")'ファイルシステムオブジェクトのクリエイト
If OUT_PTH = "" Then
WScript.Quit
End If
Set objTS = objFS.OpenTextFile(OUT_PTH,8,True)
objTS.WriteLine strFileName
objTS.Close
Set objTS = Nothing
End Sub
Function Get_Current_Directory()
Dim objWshell
Set objWshell = CreateObject("WScript.Shell")
Get_Current_Directory = objWshell.CurrentDirectory & "\"
Set objWshell = Nothing
End Function
--------------------------------------------------------------------------------