Some useful VBScripts to manipulate the FileSystemObject

 SomeTimes we need to query,update ot delete the FileSystemObjects During the Applation Installation and Development. Those scripts is a sort of way to manipulate them.

 

Function CopySingleFile(SourceFile,DestFile)
    ON ERROR RESUME NEXT
    Dim objFSO
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    if (objFSO.FileExists(SourceFile)) then
        objFSO.CopyFile(SourceFile,DestFile,True)
        else
        msgbox "The source file does not exist: " & SourceFile
    End if
    Set objFSO = Nothing
End Function

Function DeleteSingleFile(FullPathFile)
    ON ERROR RESUME NEXT
    Dim objFSO
    set objFSO=CreateObject("Scripting.FileSystemObject")
    If objFSO.FileExists(FullPathFile) then
           objFSO.DeleteFile(FullPathFile)
    End if
    Set objFSO = Nothing
End Function

Function MoveSingleFile(SourceFile,DestFile)
    ON ERROR RESUME NEXT
    Dim objFSO
    SET objFSO = CreateObject("Script.FileSystemObject")
    If objFSO.FileExists(SourceFile) then
    objFSO.MoveFile(SourceFile,DestFile)
    End if
    Set objFSO = Nothing
End Function

Function RenameFile(FullPathFile,OldName,NewName)
    ON ERROR RESUME NEXT   
    Dim objFSO
    set objFSO = CreateObject("Script.FileSystemObject")
    If objFSO.FileExists(FullPathFile) then
            objFSO.MoveFile(FullPathFile,Left(FullPathFile,Len(FullPathFile)-Len(OldName)) & NewName)
            End if
    Set objFSO = Nothing
End Function

Function RemoveReadOnlyForFile(DestFile)
    ON ERROR RESUME NEXT
    Const ReadOnly=1
    Dim objFSO
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim objFile
    If objFSO.FileExists(DestFile) then
        set objFile=objFSO.GetFile(DestFile)
        If objFile.Attributes AND ReadOnly then
        objFile.Attributes=objFile.Attributes XOR ReadOnly
        End if
    End if
    Set objFSO = Nothing
End Function

Function CreateTextFile(DestFile)
    ON ERROR RESUME NEXT
    Dim objFSO
    SET objFSO=CreateObject(Scripting.FileSystemObject)
    If not objFSO.FileExists(DestFile) then
        objFSO.CreateTextFile(DestFile)
    End if
    Set objFSO = Nothing
End Function

Function ReadTargetFile(ReadType,TypeFlag,DestFile)'
    'ReadyType can be read(x)读x个字符；readline读一行；readall全部读取
    ON ERROR RESUME NEXT
    Const ForReading=1
    Const ForAppEnding=8
    Const ForWriting=2
    ReadType=UCase(ReadType)   
    Dim objFSO
    SET objFSO=CreateObject(Scripting.FileSystemObject)
    Dim objFile
    If objFSO.FileExists(DestFile) then
        set objFile = objFSO.OpenTextFile(DestFile,ForReading,False)
        Select case ReadType
        Case "READX"
            If IsNumeric(TypeFlag) then
            ReadTargetFile=objFile.read(TypeFlag)
            End if
            objFile.close
            Exit Function
        Case "READLINE"
            If IsNumeric(TypeFlag) then
                dim i = 1
                Do while (not objFile.atEndofstream) and i < = TypeFlag
                    objFile.skipline
                    if i = typeFlag then
                    ReadTargetFile=objFile.readline(TypeFlag)
                    End if
                loop           
            End if
            objFile.close
            Exit Function
        Case "READALL"
            ReadTargetFile=objFile.readall
            objFile.close
            Exit Function
       End Select
    End if
    Set objFSO = Nothing
End Function

Function FindStringInFile(Str,DestFile)
    ON ERROR RESUME NEXT
    Const ForReading=1
    Const ForAppEnding=8
    Const ForWriting=2
    Dim objFSO
    SET objFSO=CreateObject(Scripting.FileSystemObject)
    Dim objFile
    Set objFile=objFSO.OpenTextFile(DestFile,ForReading,False)
    Dim DestString=objFile.Readall
    FindStringInFile= InStr(1,DestString,Str,1)
    if FindStringInFile = 0 or FindStringInFile= Null then
        FindStringInFile =false
    else
    FindStringInFile=True
    End if  
    Set objFile = Nothing
    Set objFSO = Nothing 
End Function

Function FindAndReplace(find,replacewith,filename)
ON ERROR RESUME NEXT
    Const ForReading=1
    Const ForAppEnding=8
    Const ForWriting=2
    Dim objFSO
    set objFSO=CreateObject(Scripting.FileSystemObject)
    Dim objFile
    Set objFile=objFSO.OpenTextFile(filename,ForWriting,True)
    Dim FileContent,FileContentReplaced
    FileContent= objFile.Readall
    FileContentReplaced=Replace(FileContent,find,replacewith,-1,1)
    If FileContect <> FileContentReplaced then
        objFile.Write FileContentReplaced
        objFile.close
        else
        objFile.close
    End if
    Set objFile = Nothing 
    Set objFSO = Nothing 
End Function

'----------------------------------------------------------文件夹操作---------------------------------------------------------------------------------------------------------------

Function CopyEntireFolderContents(SourceFolder,DestFolder) 'including files and subfolder contents
    ON ERROR RESUME NEXT
    Dim objFSO
    set objFSO = CreateObject("Scripting.FileSystemobject")
        If objFSO.FolderExists(SourceFolder) then
        objFSO.CopyFolder(sourceFolder,DestFolder,True)
        else
        msgbox "The source folder does not exist: " & SourceFolder
        End if
    Set objFSO = Nothing 
End Function

Function DeleteEntireFolder(DestFolder)
    ON ERROR RESUME NEXT
    dim objFSO : set objFSO = CreateObject("Scripting.FileSystemObject")
    if objFSO.FolderExists((DestFolder) then
        objFSO.DeteleFolder(DestFolder)
    End if
    Set objFSO = Nothing 
End Function

Function CopyEntireFolderContentsExceptSubFolder(SourceFolder,DestFolder) 'only copy the files under source folder
    ON ERROR RESUME NEXT
    Dim sFile,sFiles,sFolder
    Dim objFSO : SET objFSO=CreateObjects("scripting.FileSystemobject")
    if objFSO.FolderExists(SourceFolder) then
        If not objFSO.FolderExist(DestFolder) then
            objFSO.CreateFolder(DestFolder)
        End if
        set sFolder=objFSO.GetFolder(SourceFolder)
        set sFiles=sfolder.Files
        For each sFile in sFiles
           CopySingleFile(SourceFolder & "/" & sFile.Name,DestFolder & "/" & sFile.Name,True)
        Next
     End if
     Set objFSO = Nothing 
End Function

Sub EnsureDirectory(objpath)
    ON ERROR RESUME NEXT
    Dim iPos: iPos = 1
    Set objFS = CreateObject("Scripting.FileSystemObject")
    Do While (True)
        iPos = InStr(iPos, objpath, "/", 1)
        If iPos < 1 Then
            Exit Do
        End If
        spath = Left(objpath, iPos)
        If Not objFS.FolderExists(spath) Then
            objFS.CreateFolder spath
        End If
        iPos = iPos + 1
    Loop
    objFS.CreateFolder objpath
End Sub