VBA VBScript FilesystemObjectのClass

更新履歴

VBAのバグを修正。以下の関数の追加

• RtnDriveType
• RtnDriveVolumeName
• RtnDrivFileSystem
• RtnDrivSerialNumber
• RtnDrivShareName
• rtnDriveIsReady

VBSCript バグがなぜかあったので修正、Cscript強制起動にしました。

Name	機能	notes
Class_Initialize	初期化	ここでFSOをセットする
GetString[roperty Let]		Property Let GetString(strFullfilename)
getBuilds[Property Let]
CopyMoveObject	ファイルまたはフォルダを移動またはコピーする。上書きするかはblForceで決定	CopyMoveObject(sf As String, tf As String, MorC As String, blForce As Boolean) As String sf ソースファイル, tf ターゲットファイル MorC M.Move C Copy, blforce Trueなら同名上書き
ReturnFSOSpecialFolder		ReturnFSOSpecialFolder(var0to2integer) FilesystemObjectで返る３種類のフォルダーの数値0,1,2をvar0to2integerに代入
DriveSpace	FullPathfileNeme or 絶対パスでGB単位で容量を返す
isExistsPathName
Exitfilecheck
builderpathName	"E:\folder1;name;name1;neme"のようにセミコロンで区切られた文字列をパス名にする。
fnAttritubetString
strFilefolder
blfilefolder
BaseString
ExtString
fnAtt
fsize
Fparent
AccexportFunction
fDrv
FDrvletter
Fn_AbsolutePathName
FileVer
isRoot
CreatedTime
LastWriteTime
LastAccessTime
Shorting
OpenWTSRA
OpenWTSR500
OpenWTSRL
OpenATSRA
OpenATSR500
OpenATSRL
AlmostLinesCount
IsDriveExists	Driveが存在しているか
RtnDriveType
RtnDriveVolumeName
RtnDrivFileSystem
RtnDrivSerialNumber
RtnDrivShareName
rtnDriveIsReady
Class_Terminate	終了処理。デコンストラクタ。

Class Module

Option Explicit
'Class Name =ClassFSO
' Ver 20190301
Const Scrun = "C:\Windows\System32\scrrun.dll"
Private Fso As Variant '// Scripting.FileSystemObject のインスタンス
'Private FSO As Scripting.FileSystemObject ' // Microsoft Scripting Runtimeを 参照設定した場合はこちら
Private strFile As String 'ファイルのフルパス変数
Private blFD As Boolean 'FileかFolder/Directoryの判定
Private blEr As Boolean 'エラー判定
Private FileFolderSize As Long 'ファイル、フォルダのサイズ
Private strBuild As String
Private arbuild
Private CopyObject  As String
Private DistObject   As String
Private CopyMoveCheck
Private blForceCopyMove
Private Const LimitCharcters = 500
Private Const LimitReadAllSize = 2000
Private Const limitReadLines = 5

'// クラス初期化
Private Sub Class_Initialize()
Set Fso = CreateObject("Scripting.FileSystemObject")
'Set FSO = New Scripting.FileSystemObject '参照設定している
blFD = False
blEr = False
strFile = ""
End Sub
'[|:-------------------------------------------------------------:|]
' プロパティ
'// Accessor 1
Public Property Let GetString(strFullfilename)
strFile = strFullfilename
Call Exitfilecheck(strFile)
End Property
'// Accessor 2
Property Let getBuilds(strFolder As String)
arbuild = Split(strFolder, ";")
End Property
'[|:-------------------------------------------------------------:|]

'// Accessor 3
Function CopyMoveObject(sf As String, tf As String, MorC As String, blForce As Boolean) As String
If LCase(StrConv(MorC, vbNarrow)) = "copy" Then
If Fso.FileExists(sf) = True Then
Fso.CopyFile sf, tf, blForce
CopyMoveObject = "File Copy Source:=" & sf & vbTab & "Distination:=" & tf & vbTab & "Force:=" & blForce & vbTab & "Result:=" & True
Exit Function
ElseIf Fso.FolderExists(sf) = True Then
Fso.CopyFolder sf, tf, blForce
CopyMoveObject = "Folder Copy Source:=" & sf & vbTab & "Distination:=" & tf & vbTab & "Force:=" & blForce & vbTab & "Result:=" & True
Exit Function
End If
Else
If Fso.FileExists(sf) = True Then
Fso.MoveFile sf, tf, blForce
CopyMoveObject = "File Move Source:=" & sf & vbTab & "Distination:=" & tf & vbTab & "Force:=" & blForce & vbTab & "Result:=" & True
Exit Function
ElseIf Fso.FolderExists(sf) = True Then
Fso.MoveFolder sf, tf, blForce
CopyMoveObject = "Folder Move Source:=" & sf & vbTab & "Distination:=" & tf & vbTab & "Force:=" & blForce & vbTab & "Result:=" & True
Exit Function
End If
End If
End Function
'[|:-------------------------------------------------------------:|]

Function ReturnFSOSpecialFolder(var0to2integer)
'FilesystemObjectで返る３種類のフォルダーの文字列0,1,2を代入
If Int(Abs(var0to2integer)) >= 0 And Int(Abs(var0to2integer)) <= 2 Then
Select Case Int(Abs(var0to2integer))
Case Is = 0
ReturnFSOSpecialFolder = Fso.GetSpecialFolder(0).Path 'Const WindowsFolder=0 'Windows オペレーティング システムによりセットアップされたファイルの置かれている Windows フォルダが返されます
Case Is = 1
ReturnFSOSpecialFolder = Fso.GetSpecialFolder(1).Path 'Const SystemFlder =1 'ライブラリ、フォント、デバイス ドライバなどの置かれている System フォルダが返されます。
Case Is = 2
ReturnFSOSpecialFolder = Fso.GetSpecialFolder(2).Path 'Const TemporaryFolder =2 '一時ファイルの格納に使用される Temp フォルダが返されます。このパスは、環境変数 TMP より取得します。
End Select
End If
End Function
Function DriveSpace(strFile)
'GB単位で返す
DriveSpace = Fso.GetDrive(Fso.GetDriveName(strFile)).FreeSpace / 1024 / 1024 / 1024
End Function
'[|:-------------------------------------------------------------:|]

'// Accessor 1 Checker
Function isExistsPathName()
Dim bl
'If blEr = True Then MsgBox "File Or Folder Not Exist", vbCritical + vbOKOnly, "ERROR": Call Class_Terminate
If blEr = True Then Debug.Print "File Or Folder Not Exist"
bl = Fso.FileExists(strFile) Xor Fso.FolderExists(strFile)
If bl = False Then
isExistsPathName = False
Debug.Print "File Or Folder Not Exist"
Call Class_Terminate
Else
isExistsPathName = True
End If
End Function
'[|:-------------------------------------------------------------:|]

Private Sub Exitfilecheck(strFile)
'フォルダが存在すればフォルダと判定し、ファイルが存在すればファイルがあると判定（フォルダ名優先）、ないならエラーとする
If Fso.FolderExists(strFile) = True Then
blFD = False
blEr = False
FileFolderSize = Fso.GetFolder(strFile).Size
ElseIf Fso.FileExists(strFile) = True Then
blFD = True
blEr = False
FileFolderSize = Fso.GetFile(strFile).Size
Else
blEr = True
End If
End Sub
'[|:-------------------------------------------------------------:|]

Function builderpathName() As String
' セミコロンで区切られた文字列をフォルダー名にして返す
' cFSO.getBuilds = "E:\folder1;name;name1;neme"
Dim buf As String
Dim i As Long
buf = arbuild(LBound(arbuild))
For i = LBound(arbuild) + 1 To UBound(arbuild)
buf = Fso.BuildPath(buf, arbuild(i))
Next i
builderpathName = buf
End Function
'[|:-------------------------------------------------------------:|]

Function fnAttritubetString() As String
' 属性を文字列で返す
Dim buf As String
Dim lngAtt As Long
If blFD = True Then
lngAtt = Fso.GetFile(strFile).Attributes
Else
lngAtt = Fso.GetFolder(strFile).Attributes
End If
If lngAtt Mod 2 <> 0 Then buf = buf & "ReadOnly,": lngAtt = lngAtt - 1
If lngAtt Mod 8 <> 0 Then buf = buf & "Hidden,": lngAtt = lngAtt - 2
Select Case True
Case lngAtt = 128
fnAttritubetString = buf & "CompressedFile"
Exit Function
Case lngAtt = 64
fnAttritubetString = buf & "リンクまたはショートカット"
Exit Function
Case lngAtt = 32
fnAttritubetString = buf & "Archive File"
Exit Function
Case lngAtt = 16
fnAttritubetString = buf & "Folder Or Directory"
Exit Function
Case lngAtt = 8
fnAttritubetString = buf & "Disk Drive Volume Label"
Exit Function
Case lngAtt = 4
fnAttritubetString = buf & "System"
Exit Function
Case Else
fnAttritubetString = buf & "Unspecified"
Exit Function
End Select
End Function
'[|:-------------------------------------------------------------:|]

Function strFilefolder() As String
'ファイルかフォルダーか文字列で返す
If blFD = False Then strFilefolder = "Folder" Else strFilefolder = "File"
End Function
Function blfilefolder() As String
'ファイルかフォルダーかTrue /False で返す FileならTrue
If blFD = False Then blfilefolder = False Else blfilefolder = True
End Function
Function BaseString() As String
'ファイルのベースネームを返す
If blFD = True Then
BaseString = Fso.getBaseName(strFile)
Else
BaseString = ""
End If
End Function
'[|:-------------------------------------------------------------:|]

Function ExtString() As String
'ファイルの拡張子を返す
If blFD = True Then
ExtString = Fso.GetExtensionName(strFile)
Else
ExtString = ""
End If
End Function
Function fnAtt() As Long
If blFD = True Then
fnAtt = Fso.GetFile(strFile).Attributes
Else
fnAtt = Fso.GetFolder(strFile).Attributes
End If
End Function

Function fsize() As Long
'ファイルかフォルダーの容量を返す
fsize = FileFolderSize
End Function
Function Fparent() As String
'ファイルの親フォルダを返す
If blFD = True Then
Fparent = Fso.GetParentFolderName(strFile)
Else
Fparent = strFile
End If
End Function
'[|:-------------------------------------------------------------:|]
Function fDrv() As String
'ファイル、フォルダのドライブレターを返す
If blFD = True Then
fDrv = Fso.GetDriveName(strFile)
Else
fDrv = Fso.GetFolder(strFile).Drive
End If
End Function
Function FDrvletter() As String
'ファイル、フォルダのドライブレターを返す FDrvと違い、わからなければ空白を返す
FDrvletter = Fso.GetDriveName(strFile)
End Function
Function Fn_AbsolutePathName() As String
'ファイル、フォルダの絶対パスを返す
Fn_AbsolutePathName = Fso.GetAbsolutePathName(strFile)
End Function
Function FileVer() As String
'ファイルのバージョンがあれば返す
If blFD = True Then
FileVer = Fso.GetFileVersion(strFile)
End If
End Function
'[|:-------------------------------------------------------------:|]
Function isRoot() As Boolean
'ルートであればTrueを返す
If blFD = False Then
isRoot = Fso.GetFolder(strFile).IsRootFolder
Else
isRoot = False
End If
End Function
Function CreatedTime() As Date
'作成日時
If blFD = True Then
CreatedTime = Fso.GetFile(strFile).DateCreated
Else
CreatedTime = Fso.GetFolder(strFile).DateCreated
End If
End Function
Function LastWriteTime() As Date
If blFD = True Then
LastWriteTime = Fso.GetFile(strFile).DateLastModified
Else
LastWriteTime = Fso.GetFolder(strFile).DateLastModified
End If
End Function
Function LastAccessTime() As Date
If blFD = True Then
LastAccessTime = Fso.GetFile(strFile).DateLastAccessed
Else
LastAccessTime = Fso.GetFolder(strFile).DateLastAccessed
End If
End Function
Function Shorting() As String
'8dot3形式のフォルダ名、またはフルパスのファイル名を返す
Dim ar, i As Long
Dim buf As String
ar = Split(strFile, "\")
buf = ar(0) & "\"
If blFD = False Then
For i = 1 To UBound(ar)
If i = 1 Then
buf = Fso.GetFolder(buf & ar(i)).ShortPath
Else
buf = Fso.GetFolder(buf & "\" & ar(i)).ShortPath
End If
Next
Shorting = buf
Else
For i = 1 To UBound(ar) - 1
If i = 1 Then
buf = Fso.GetFolder(buf & ar(i)).ShortPath
Else
buf = Fso.GetFolder(buf & "\" & ar(i)).ShortPath
End If
Next
Shorting = buf & "\" & Fso.GetFile(buf & "\" & ar(UBound(ar))).ShortName
End If
End Function
Function OpenWTSRA() As String
If blFD = True Then
If FileFolderSize <= LimitReadAllSize Then
OpenWTSRA = Fso.OpenTextFile(strFile, 1, False, -1).ReadAll
End If
End If
End Function
Function OpenWTSR500() As String
'Unicode形式でLimitCharacters = 500文字読み込む
If blFD = True Then
OpenWTSR500 = Fso.OpenTextFile(strFile, 1, False, -1).Read(LimitCharcters)
End If
End Function
Function OpenWTSRL() As String
'Unicode形式でLimitReadlinesか文末まで読み込む
Dim TS
Dim buf
Dim n As Long
If blFD = True Then
n = 0
Set TS = Fso.OpenTextFile(strFile, 1, False, -1)
Do Until TS.AtEndOfStream
buf = buf & TS.ReadLine & vbCrLf
If n >= limitReadLines Then Exit Do Else n = n + 1
Loop
TS.Close
Set TS = Nothing
OpenWTSRL = buf
End If
End Function
'[|:-------------------------------------------------------------:|]
Function OpenATSRA() As String
'Unicode形式で2000バイトまでのファイルを読み込む
Dim buf As String
If blFD = True Then
If FileFolderSize <= LimitReadAllSize Then
OpenATSRA = Fso.OpenTextFile(strFile, 1, False, 0).ReadAll
End If
End If
End Function
Function OpenATSR500() As String
'ASCII形式でLimitCharacters = 500文字読み込む
Dim buf As String
If blFD = True Then
OpenATSR500 = Fso.OpenTextFile(strFile, 1, False, 0).Read(LimitCharcters)
End If
End Function
Function OpenATSRL() As String
'ASCII形式でLimitReadlinesか文末まで読み込む
Dim TS
Dim buf
Dim n As Long
If blFD = True Then
n = 0
Set TS = Fso.OpenTextFile(strFile, 1, False, 0)
Do Until TS.AtEndOfStream
buf = buf & TS.ReadLine & vbCrLf
If n >= limitReadLines Then Exit Do Else n = n + 1
Loop
TS.Close
Set TS = Nothing
OpenATSRL = buf
End If
End Function
'[|:-------------------------------------------------------------:|]

Function AlmostLinesCount() As Long
'空の改行を含めて何行あるかおよその検討をつける関数
'Const ForAppending = 8
    Dim TS 'As TextStream
    Dim i As Long
    If blFD = True Then
    Set TS = Fso.OpenTextFile(strFile, 8)
    i = TS.Line
    TS.Close
    Set TS = Nothing
    AlmostLinesCount = i
    End If
End Function
'[|:-------------------------------------------------------------:|]
Function IsDriveExists() As Boolean
' Driveが存在するかを返す
If blFD Then IsDriveExists = CBool(Fso.DriveExists(Fso.GetFile(strFile).Drive)) Else IsDriveExists = CBool(Fso.DriveExists(Fso.GetFolder(strFile).Drive))
End Function
'[|:-------------------------------------------------------------:|]
'[|:-------------------------------------------------------------:|]
Function RtnDriveType(DrvPath)
Dim ar
ar = Split("Unknown/不明/0,Removeable/1,Fixed/固定、ローカル(USB含む)/クライアントのハードディスク/2,Network/ネットワーク上のドライブ/3,CD-ROM/DVDも含む/4,RAM Disk/5", ",")
RtnDriveType = ar(Fso.GetDrive(DrvPath).DriveType)
End Function
Function RtnDriveVolumeName(DrvPath)
Dim d: Set d = Fso.GetDrive(DrvPath)
If d.DriveType = 1 Or d.DriveType = 4 Then
      If d.IsReady = True Then
      RtnDriveVolumeName = d.VolumeName
      Else
      RtnDriveVolumeName = "Drive　in not Ready. Drive VolueName is Unknown."
      End If
Else
RtnDriveVolumeName = d.VolumeName
End If
End Function
Function RtnDrivFileSystem(DrvPath)
'https://docs.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/filesystem-property
'戻り値の種類は FAT、NTFS、および CDFS です。ただしCD-ROMはディスクが入っている場合だけ値を返します。
Dim d: Set d = Fso.GetDrive(DrvPath)
If d.DriveType = 1 Or d.DriveType = 4 Then
      If d.IsReady = True Then
      RtnDrivFileSystem = d.FileSystem
      Else
      RtnDrivFileSystem = "Drive　in not Ready. Drive Filesystem is Unknown."
      End If
Else
RtnDrivFileSystem = d.FileSystem
End If
End Function
Function RtnDrivSerialNumber(DrvPath)
'https://docs.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/serialnumber-property
'ディスク ボリュームを一意に識別するための 10 進数のシリアル値を返します。
Dim d: Set d = Fso.GetDrive(DrvPath)
If d.DriveType = 1 Or d.DriveType = 4 Then
      If d.IsReady = True Then
      RtnDrivFileSystem = d.SerialNumber
      Else
      RtnDrivFileSystem = "Drive　in not Ready. Drive Serial Number is Unknown."
      End If
Else
RtnDrivFileSystem = d.SerialNumber
End If
End Function
Function RtnDrivShareName(DrvPath)
'https://docs.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/serialnumber-property
'ネットワーク ドライブでない場合、ShareName プロパティは長さ 0 の文字列 ("") を返します。ネットワーク ドライブでである場合、ディスク ボリュームを一意に識別するための 10 進数のシリアル値を返します。
Dim d: Set d = Fso.GetDrive(DrvPath)
On Error GoTo Err_Handle
RtnDrivShareName = d.ShareName
Exit Function
Err_Handle:
Debug.Print Err.Number, Err.Description
Err.Clear
End Function
Function rtnDriveIsReady(DrvPath) 'As Drive)
'https://docs.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/isready-property
If Fso.GetDrive(DrvPath).DriveType = 1 Or Fso.GetDrive(DrvPath).DriveType = 4 Then
DriveIsReady = Fso.GetDrive(DrvPath).isreadry
Else
DriveIsReady = False
End If
End Function
'[|:-------------------------------------------------------------:|]
'[|:-------------------------------------------------------------:|]
Private Sub Class_Terminate()
If Not Fso Is Nothing Then Set Fso = Nothing
End Sub

標準モジュール

Sub cFSOSample()
Dim cFSO As ClassFSO: Set cFSO = New ClassFSO
On Error Resume Next
cFSO.GetString = "C:\hoge\hoge.txt"
cFSO.getBuilds = "X:\folder1;size;11;subfolders;err"
With cFSO
Debug.Print .ReturnFSOSpecialFolder(1)
Stop
If cFSO.isExistsPathName = False Then Exit Sub
Debug.Print .AlmostLinesCount
Debug.Print .DriveSpace
Debug.Print .IsDriveExists
Debug.Print .BaseString
Debug.Print .ExtString
Debug.Print .CreatedTime
Debug.Print .Shorting
Debug.Print .fDrv
Debug.Print .FDrvletter
Debug.Print .strFilefolder
Debug.Print .Fparent
Debug.Print .fnAttritubetString
Debug.Print .fnAtt
Debug.Print .fsize
Debug.Print .isRoot
Debug.Print .LastAccessTime
Debug.Print .LastWriteTime
Debug.Print .OpenATSR500
Debug.Print .OpenATSRL
Debug.Print .builderpathName
End With
Set cFSO = Nothing
End Sub

Excel用の参照設定付加マクロ

これを動かしてから、クラスを参照設定に変えてもよい

Sub ExcelAddSccrun()
'For Excel VBA Only
'参照設定をつけるマクロ
Const Scrun = "C:\Windows\System32\scrrun.dll"
Dim ref
Dim vbPro
Dim blTEst As Boolean
blTEst = False
Set vbPro = ActiveWorkbook.VBProject
For Each ref In vbPro.references
Debug.Print ref.Name
If ref.Name = "Scripting" Then blTEst = True
Next
If blTEst = False Then
ActiveWorkbook.VBProject.references.AddFromFile Scrun
End If
End Sub

VBScript

Option Explicit
'Ver 20190216
'VbscriptはClass内にCostが記述できない
Const LimitCharcters  = 500 '読み込む文字数の制限
Const LimitReadAllSize = 2000 'ReadAllの容量制限
Const limitReadLines = 5 '行単位で読み込む場合の制限
'[|:------------------ VBScript Class ClassFSO Block -----------------:|]
Class ClassFSO
'Class Name =ClassFSO
Private Fso 'As Variant '// Scripting.FileSystemObject のインスタンス
Private strfile 'As String 'ファイルのフルパス変数
Private blFD 'As Boolean 'FileかFolder/Directoryの判定
Private blEr 'As Boolean 'エラー判定
Private FileFolderSize 'As Long 'ファイル、フォルダのサイズ
Private strBuild 'As String
Private arbuild
Private CopyObject  'As String
Private DistObject   'As String
Private CopyMoveCheck
Private blForceCopyMove

'[|:--------------------- VBScript Class ------------------------------:|]
'// クラス初期化
Private Sub Class_Initialize()
Set Fso = CreateObject("Scripting.FileSystemObject")
'Set FSO = New Scripting.FileSystemObject '参照設定している
blFD = False
blEr = False
strfile = ""
End Sub
'[|:--------------------- VBScript Class ------------------------------:|]
' プロパティ
'// Accessor 1
Public Property Let GetString(strFullfilename)
strfile = strFullfilename
Call Exitfilecheck(strfile)
End Property
'// Accessor 2
Property Let getBuilds(strFolder)
arbuild = Split(strFolder, ";")
End Property
'// Accessor 3
Function CopyMoveObject(sf, tf, MorC, blForce)
' VBA版と異なり、File Folderのcopy / Moveが成功したらTrueを返す
' strConv関数がない(使用する場合はBasp21が必要)
' sf Srouce File / Folder
' tf Desitination(Target) File/ Folder
' 半角のCopy以外はすべてMove
' MorC As String "Copy" or other(ex "copy" means "move")
' blForce As Boolean (Copy Move force)
If LCase(MorC) = "copy" Then
If FSO.FileExists(sf) = True Then
FSO.CopyFile sf, tf, blForce
CopyMoveObject = True
Exit Function
ElseIf FSO.FolderExists(sf) = True Then
FSO.CopyFolder sf, tf, blForce
CopyMoveObject = True
Exit Function
End If
Else
If FSO.FileExists(sf) = True Then
FSO.MoveFile sf, tf, blForce
CopyMoveObject = True
Exit Function
ElseIf FSO.FolderExists(sf) = True Then
FSO.MoveFolder sf, tf, blForce
CopyMoveObject = True
Exit Function
End If
End If
CopyMoveObject = False
End Function
'[|:--------------------- VBScript Class ------------------------------:|]
Function ReturnFSOSpecialFolder(var0to2integer)
If Int(Abs(var0to2integer)) >= 0 And Int(Abs(var0to2integer)) <= 2 Then
IF  Int(Abs(var0to2integer))= 0 Then
ReturnFSOSpecialFolder = Fso.GetSpecialFolder(0).Path 'Const WindowsFolder=0 'Windows オペレーティング システムによりセットアップされたファイルの置かれている Windows フォルダが返されます
ElseIF Int(Abs(var0to2integer))= 1 Then
ReturnFSOSpecialFolder = Fso.GetSpecialFolder(1).Path 'Const SystemFlder =1 'ライブラリ、フォント、デバイス ドライバなどの置かれている System フォルダが返されます。
ElseIf  Int(Abs(var0to2integer))= 2 Then
ReturnFSOSpecialFolder = Fso.GetSpecialFolder(2).Path 'Const TemporaryFolder =2 '一時ファイルの格納に使用される Temp フォルダが返されます。このパスは、環境変数 TMP より取得します。
End If
End If
End Function
'[|:--------------------- VBScript Class ------------------------------:|]
Function DriveSpace()
'GB単位で返す
DriveSpace = Fso.GetDrive(Fso.GetDriveName(strfile)).FreeSpace / 1024 / 1024 / 1024
End Function

'// Accessor 1 Checker
Function isExistsPathName()
Dim bl
'If blEr = True Then MsgBox "File Or Folder Not Exist", vbCritical + vbOKOnly, "ERROR": Call Class_Terminate
If blEr = True Then Wscript.Echo  "File Or Folder Not Exist"
bl = Fso.FileExists(strfile) Xor Fso.FolderExists(strfile)
If bl = False Then
isExistsPathName = False
Wscript.Echo  "File Or Folder Not Exist"
Call Class_Terminate
Else
isExistsPathName = True
End If
End Function
'[|:--------------------- VBScript Class ------------------------------:|]
Private Sub Exitfilecheck(strfile)
'フォルダが存在すればフォルダと判定し、ファイルが存在すればファイルがあると判定（フォルダ名優先）、ないならエラーとする
If Fso.FolderExists(strfile) = True Then
blFD = False
blEr = False
FileFolderSize = Fso.GetFolder(strfile).Size
ElseIf Fso.FileExists(strfile) = True Then
blFD = True
blEr = False
FileFolderSize = Fso.GetFile(strfile).Size
Else
blEr = True
End If
End Sub
'[|:--------------------- VBScript Class ------------------------------:|]
Function builderpathName() 'As String
' セミコロンで区切られた文字列をフォルダー名にして返す
' cFSO.getBuilds = "E:\folder1;name;name1;neme"
Dim buf 'As String
Dim i 'As Long
buf = arbuild(LBound(arbuild))
For i = LBound(arbuild) + 1 To UBound(arbuild)
buf = Fso.BuildPath(buf, arbuild(i))
Next
builderpathName = buf
End Function
'[|:--------------------- VBScript Class ------------------------------:|]
Function fnAttritubetString() 'As String
' 属性を文字列で返す
Dim buf 'As String
Dim lngAtt 'As Long
If blFD = True Then
lngAtt = Fso.GetFile(strfile).Attributes
Else
lngAtt = Fso.GetFolder(strfile).Attributes
End If
If lngAtt Mod 2 <> 0 Then buf = buf & "ReadOnly,": lngAtt = lngAtt - 1
If lngAtt Mod 8 <> 0 Then buf = buf & "Hidden,": lngAtt = lngAtt - 2
Select Case True
Case lngAtt = 128
fnAttritubetString = buf & "CompressedFile"
Exit Function
Case lngAtt = 64
fnAttritubetString = buf & "リンクまたはショートカット"
Exit Function
Case lngAtt = 32
fnAttritubetString = buf & "Archive File"
Exit Function
Case lngAtt = 16
fnAttritubetString = buf & "Folder Or Directory"
Exit Function
Case lngAtt = 8
fnAttritubetString = buf & "Disk Drive Volume Label"
Exit Function
Case lngAtt = 4
fnAttritubetString = buf & "System"
Exit Function
Case Else
fnAttritubetString = buf & "Unspecified"
Exit Function
End Select
End Function
'[|:--------------------- VBScript Class ------------------------------:|]
Function strFilefolder() 'As String
'ファイルかフォルダーか文字列で返す
If blFD = False Then strFilefolder = "Folder" Else strFilefolder = "File"
End Function
Function blfilefolder() 'As String
'ファイルかフォルダーかTrue /False で返す FileならTrue
If blFD = False Then blfilefolder = False Else blfilefolder = True
End Function
Function BaseString() 'As String
'ファイルのベースネームを返す
If blFD = True Then
BaseString = Fso.getBaseName(strfile)
Else
BaseString = ""
End If
End Function
Function ExtString() 'As String
'ファイルの拡張子を返す
If blFD = True Then
ExtString = Fso.GetExtensionName(strfile)
Else
ExtString = ""
End If
End Function
'[|:--------------------- VBScript Class ------------------------------:|]
Function fnAtt() 'As Long
If blFD = True Then
fnAtt = Fso.GetFile(strfile).Attributes
Else
fnAtt = Fso.GetFolder(strfile).Attributes
End If
End Function
'[|:--------------------- VBScript Class ------------------------------:|]
Function fsize() 'As Long
'ファイルかフォルダーの容量を返す
fsize = FileFolderSize
End Function
'[|:--------------------- VBScript Class ------------------------------:|]
Function Fparent() 'As String
'ファイルの親フォルダを返す
If blFD = True Then
Fparent = Fso.GetParentFolderName(strfile)
Else
Fparent = strfile
End If
End Function
'[|:--------------------- VBScript Class ------------------------------:|]
Function fDrv() 'As String
'ファイル、フォルダのドライブレターを返す
If blFD = True Then
fDrv = Fso.GetDriveName(strfile)
Else
fDrv = Fso.GetFolder(strfile).Drive
End If
End Function
Function FDrvletter() 'As String
'ファイル、フォルダのドライブレターを返す FDrvと違い、わからなければ空白を返す
FDrvletter = Fso.GetDriveName(strfile)
End Function
'[|:--------------------- VBScript Class ------------------------------:|]
Function Fn_AbsolutePathName() 'As String
'ファイル、フォルダの絶対パスを返す
Fn_AbsolutePathName = Fso.GetAbsolutePathName(strfile)
End Function
'[|:--------------------- VBScript Class ------------------------------:|]
Function FileVer() 'As String
'ファイルのバージョンがあれば返す
If blFD = True Then
FileVer = Fso.GetFileVersion(strfile)
End If
End Function
'[|:--------------------- VBScript Class ------------------------------:|]
Function isRoot() 'As Boolean
'ルートであればTrueを返す
If blFD = False Then
isRoot = Fso.GetFolder(strfile).IsRootFolder
Else
isRoot = False
End If
End Function
'[|:--------------------- VBScript Class ------------------------------:|]
Function CreatedTime() 'As Date
'作成日時
If blFD = True Then
CreatedTime = Fso.GetFile(strfile).DateCreated
Else
CreatedTime = Fso.GetFolder(strfile).DateCreated
End If
End Function
Function LastWriteTime() 'As Date
If blFD = True Then
LastWriteTime = Fso.GetFile(strfile).DateLastModified
Else
LastWriteTime = Fso.GetFolder(strfile).DateLastModified
End If
End Function
Function LastAccessTime() 'As Date
If blFD = True Then
LastAccessTime = Fso.GetFile(strfile).DateLastAccessed
Else
LastAccessTime = Fso.GetFolder(strfile).DateLastAccessed
End If
End Function
Function Shorting() 'As String
'8dot3形式のフォルダ名、またはフルパスのファイル名を返す
Dim ar, i 'As Long
Dim buf 'As String
ar = Split(strfile, "\")
buf = ar(0) & "\"
If blFD = False Then
For i = 1 To UBound(ar)
If i = 1 Then
buf = Fso.GetFolder(buf & ar(i)).ShortPath
Else
buf = Fso.GetFolder(buf & "\" & ar(i)).ShortPath
End If
Next
Shorting = buf
Else
For i = 1 To UBound(ar) - 1
If i = 1 Then
buf = Fso.GetFolder(buf & ar(i)).ShortPath
Else
buf = Fso.GetFolder(buf & "\" & ar(i)).ShortPath
End If
Next
Shorting = buf & "\" & Fso.GetFile(buf & "\" & ar(UBound(ar))).ShortName
End If
End Function
'[|:--------------------- VBScript Class ------------------------------:|]
Function OpenWTSRA() 'As String
If blFD = True Then
If FileFolderSize <= LimitReadAllSize Then
OpenWTSRA = Fso.OpenTextFile(strfile, 1, False, -1).ReadAll
End If
End If
End Function
Function OpenWTSR500() 'As String
'Unicode形式でLimitCharacters = 500文字読み込む
If blFD = True Then
OpenWTSR500 = Fso.OpenTextFile(strfile, 1, False, -1).Read(LimitCharcters)
End If
End Function
'[|:--------------------- VBScript Class ------------------------------:|]
Function OpenWTSRL() 'As String
'Unicode形式でLimitReadlinesか文末まで読み込む
Dim TS
Dim buf
Dim n 'As Long
If blFD = True Then
n = 0
Set TS = Fso.OpenTextFile(strfile, 1, False, -1)
Do Until TS.AtEndOfStream
buf = buf & TS.ReadLine & vbCrLf
If n >= limitReadLines Then Exit Do Else n = n + 1
Loop
TS.Close
Set TS = Nothing
OpenWTSRL = buf
End If
End Function
'[|:--------------------- VBScript Class ------------------------------:|]
Function OpenATSRA() 'As String
'Unicode形式で2000バイトまでのファイルを読み込む
Dim buf 'As String
If blFD = True Then
If FileFolderSize <= LimitReadAllSize Then
OpenATSRA = Fso.OpenTextFile(strfile, 1, False, 0).ReadAll
End If
End If
End Function
Function OpenATSR500() 'As String
'ASCII形式でLimitCharacters = 500文字読み込む
Dim buf 'As String
If blFD = True Then
OpenATSR500 = Fso.OpenTextFile(strfile, 1, False, 0).Read(LimitCharcters)
End If
End Function
Function OpenATSRL() 'As String
'ASCII形式でLimitReadlinesか文末まで読み込む
Dim TS
Dim buf
Dim n 'As Long
If blFD = True Then
n = 0
Set TS = Fso.OpenTextFile(strfile, 1, False, 0)
Do Until TS.AtEndOfStream
buf = buf & TS.ReadLine & vbCrLf
If n >= limitReadLines Then Exit Do Else n = n + 1
Loop
TS.Close
Set TS = Nothing
OpenATSRL = buf
End If
End Function
'[|:--------------------- VBScript Class ------------------------------:|]
Function AlmostLinesCount() 'As Long
'空の改行を含めて何行あるかおよその検討をつける関数
'Const ForAppending = 8
    Dim TS 'As TextStream
    Dim i 'As Long
    If blFD = True Then
    Set TS = Fso.OpenTextFile(strfile, 8)
    i = TS.Line
    TS.Close
    Set TS = Nothing
    AlmostLinesCount = i
    End If
End Function
Function IsDriveExists() 'As Boolean
If blFD Then IsDriveExists = CBool(Fso.DriveExists(Fso.GetFile(strfile).Drive)) Else IsDriveExists = CBool(Fso.DriveExists(Fso.GetFolder(strfile).Drive))
End Function
'[|:--------------------- VBScript Class New Add-----------------------:|]
'[|:--------------------- VBScript Class New Add-----------------------:|]
Function RtnDriveType(DrvPath)
Dim ar
ar = Split("Unknown/不明/0,Removeable/1,Fixed/固定、ローカル(USB含む)/クライアントのハードディスク/2,Network/ネットワーク上のドライブ/3,CD-ROM/DVDも含む/4,RAM Disk/5", ",")
RtnDriveType = ar(Fso.GetDrive(DrvPath).DriveType)
End Function
Function RtnDriveVolumeName(DrvPath)
Dim d: Set d = Fso.GetDrive(DrvPath)
If d.DriveType = 1 Or d.DriveType = 4 Then
      If d.IsReady = True Then
      RtnDriveVolumeName = d.VolumeName
      Else
      RtnDriveVolumeName = "Drive　in not Ready. Drive VolueName is Unknown."
      End If
Else
RtnDriveVolumeName = d.VolumeName
End If
End Function
Function RtnDrivFileSystem(DrvPath)
'https://docs.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/filesystem-property
'戻り値の種類は FAT、NTFS、および CDFS です。ただしCD-ROMはディスクが入っている場合だけ値を返します。
Dim d: Set d = Fso.GetDrive(DrvPath)
If d.DriveType = 1 Or d.DriveType = 4 Then
      If d.IsReady = True Then
      RtnDrivFileSystem = d.FileSystem
      Else
      RtnDrivFileSystem = "Drive　in not Ready. Drive Filesystem is Unknown."
      End If
Else
RtnDrivFileSystem = d.FileSystem
End If
End Function
Function RtnDrivSerialNumber(DrvPath)
'https://docs.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/serialnumber-property
'ディスク ボリュームを一意に識別するための 10 進数のシリアル値を返します。
Dim d: Set d = Fso.GetDrive(DrvPath)
If d.DriveType = 1 Or d.DriveType = 4 Then
      If d.IsReady = True Then
      RtnDrivFileSystem = d.SerialNumber
      Else
      RtnDrivFileSystem = "Drive　in not Ready. Drive Serial Number is Unknown."
      End If
Else
RtnDrivFileSystem = d.SerialNumber
End If
End Function
Function RtnDrivShareName(DrvPath)
'https://docs.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/serialnumber-property
'ネットワーク ドライブでない場合、ShareName プロパティは長さ 0 の文字列 ("") を返します。ネットワーク ドライブでである場合、ディスク ボリュームを一意に識別するための 10 進数のシリアル値を返します。
Dim d: Set d = Fso.GetDrive(DrvPath)
On Error GoTo Err_Handle
RtnDrivShareName = d.ShareName
Exit Function
Err_Handle:
Debug.Print Err.Number, Err.Description
Err.Clear
End Function
Function rtnDriveIsReady(DrvPath) 'As Drive)
'https://docs.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/isready-property
If Fso.GetDrive(DrvPath).DriveType = 1 Or Fso.GetDrive(DrvPath).DriveType = 4 Then
DriveIsReady = Fso.GetDrive(DrvPath).isreadry
Else
DriveIsReady = False
End If
End Function
'[|:--------------------- VBScript Class New Add-----------------------:|]
'[|:--------------------- VBScript Class New Add-----------------------:|]
'[|:--------------------- VBScript Class ------------------------------:|]
Private Sub Class_Terminate()
If Not Fso Is Nothing Then Set Fso = Nothing
End Sub
End Class
'[|:--------------------- VBScript Cscript Force Boot Procedure -------:|]
Sub RerunCScript 'ここから
Dim Args
Dim Arg
If LCase(Right(WScript.FullName,11))="wscript.exe" Then
  Args=Array("cmd.exe /k CScript.exe",""""&WScript.ScriptFullName&"""")
  For Each Arg In WScript.Arguments
    ReDim Preserve Args(UBound(Args)+1)
    Args(UBound(Args))=""""&Arg&""""
  Next
  WScript.Quit CreateObject("WScript.Shell").Run(Join(Args),1,True)
End If
End Sub
RerunCScript 'ここまで

Dim cFSO : Set cFSO= New ClassFSO
cFSO.GetString = "C:\Users\very_\OneDrive\ドキュメント\MyScript\Functionyahoointl.jse"
cFSO.getBuilds = "X:\folder1;size;11;subfolders;err"
With cFSO
If cFSO.isExistsPathName = False Then WScript.Quit
Wscript.Echo .AlmostLinesCount
Wscript.Echo .BaseString
Wscript.Echo .ExtString
Wscript.Echo .CreatedTime
Wscript.Echo .Shorting
Wscript.Echo .fDrv
Wscript.Echo .strFilefolder
Wscript.Echo .Fparent
Wscript.Echo .fnAttritubetString
Wscript.Echo .fnAtt
Wscript.Echo .fsize
Wscript.Echo .isRoot
Wscript.Echo .LastAccessTime
Wscript.Echo .LastWriteTime
Wscript.Echo .OpenATSR500
Wscript.Echo .OpenATSRL
Wscript.Echo .builderpathName
Wscript.Echo .CopyMoveObject("C:\Users\name\hoge\hoge.txt","D:\","copy",true)
End With
Set cFSO = Nothing
WScript.Quit

参考

Fileオブジェクト - Attributesプロパティ
VBScriptでクラスやメソッドを作ってみる
第9回　VBScriptのオブジェクトを使いこなす (3/4)
テキストファイルの最終行を取得する
テキストファイル（CSVファイル含む）の行数（件数）を瞬時に取得
TextStream ファイルを読み込む（Read,ReadLine,ReadAll）
GetDrive メソッド - Docs 以前のドキュメント
ネットワーク共有名を指定した場合は、その共有が存在するかどうかが確認されます。
引数 drivespec が指定可能な形式になっていない場合、および指定したドライブが存在しない場合は、エラーが発生します。
通常のパス名を使って GetDrive メソッドを呼び出すには、最初に次のようなコードを記述して、引数 drivespec に指定できる文字列を取得します
DriveSpec = GetDriveName(GetAbsolutePathName(Path))
GetSpecialFolder メソッド - Docs 以前のドキュメント
VBScript 基本のまとめ
VBA 複数の引数をとるPropertyプロシージャ