Thursday 2 May 2013

Working with Files using File System Object


'***Checking for file existance

Public Function func_Report_FileStatus(strFileName)
   'Enable error handling
 On Error Resume Next

 'Defining Objects
    Dim objFso 'Object to hold the name of a FileSystemObject
    Set  objFso = CreateObject("Scripting.FileSystemObject")

 'Default value
 func_Report_FileStatus = True

 'Report if file exist
 If Not (objFso.FileExists(strFileName)) Then     
  func_Report_FileStatus = False
 End If

 'Release object
 Set objFso = Nothing

 'Verify if method executed successfully
 If Err.Number <> 0 Then
  Reporter.ReportEvent micFail, "Error occured in Function- ' <<func_Report_FileStatus>>' get failed","Error description: "& Err.Description & vblf & "Error number: " & Err.Number
 End If

 'Disable error handling
 On Error GoTo 0

End Function


'***This method will search an input string in an specified text file

Public Function func_SearchString_TextFile(strTextFilePath, strSearch)
 'Enable error handling
 On Error Resume Next

 'Define objects
 Set fso = CreateObject("Scripting.FileSystemObject")
 Set txtFileObj= fso.OpenTextFile(strTextFilePath, 1)

 'Get bool value regarding file existence
 intResult = InStr(txtFileObj.ReadAll,strSearch)

 'Return bool value from function
 If intResult Then
  searchAnStringFromATextFile = True
 Else
  searchAnStringFromATextFile  = False
 End If


 'Release object
  txtFileObj.Close()
  Set fso = Nothing

  'Verify if method executed successfully

 If Err.Number <> 0 Then
  Reporter.ReportEvent micFail, "Error occured in Function- ' <<func_SearchString_TextFile>>' get failed","Error description: "& Err.Description & vblf & "Error number: " & Err.Number
 End If

 'Disable error handling
 On Error GoTo 0
End Function


'***Searching a file in a given folder

Function func_VerifyFile_Existence(folderPath, fileName)
 'Enable error handling
 On Error Resume Next

 Dim fso, folderObj, strFile, fileObj
 func_VerifyFile_Existence = False

 'Create objects
 Set fso = CreateObject("Scripting.FileSystemObject")
 Set folderObj = fso.GetFolder(folderPath)
 Set fileObj = folderObj.Files


 'searching for the file
 For Each strFile In fileObj
  If Strcomp(strFile.Name,fileName) = 0 Then
   func_VerifyFile_Existence = True
   Exit For
  End If
 Next
 
 'Release object
 Set fileObj = Nothing
 Set folderObj = Nothing
 Set fso = Nothing


' Verify if method executed successfully
 If Err.Number <> 0 Then
  Reporter.ReportEvent micFail, "Error occured in Function- ' <<func_VerifyFile_Existence>>' get failed","Error description: "& Err.Description & vblf & "Error number: " & Err.Number
 End If

 'Disable error handling
 On Error GoTo 0
End Function


'***Verifying text file existence if only partial part of name is available in a Folder path
  
Function func_VerifyTextFileExistence_PartialName(folderPath, fileName,fileExt)

 'Enable error handling
 On Error Resume Next

' Declaring objects and variables
 Dim fso, folderObj, strFile, fileObj
 func_VerifyTextFileExistence_PartialName = ""

 'Create objects
 Set fso = CreateObject("Scripting.FileSystemObject")
 Set folderObj = fso.GetFolder(folderPath)
 Set fileObj = folderObj.Files

 'search for the file name
 For Each strFile In fileObj
  If(InStr(strFile.Name,fileName)<>0) And (InStr(strFile.Name,fileExt)<>0) Then
   func_VerifyTextFileExistence_PartialName = strFile.Name
   Exit For
  End If
 Next


 'Release object
 Set fileObj = Nothing
 Set folderObj = Nothing
 Set fso = Nothing


' Verify if method executed successfully
 If Err.Number <> 0 Then
  Reporter.ReportEvent micFail, "Error occured in Function- ' func_VerifyTextFileExistence_PartialName' get failed","Error description: "& Err.Description & vblf & "Error number: " & Err.Number
 End If

 'Disable error handling
 On Error GoTo 0
End Function


'***This function will move all the file present in Source Path to Destination Path

Function func_Clear_Outdir(sourcePath, destinationPath)
 On Error Resume Next
  Set fsoObject = CreateObject("Scripting.FileSystemObject")
  fsoObject.MoveFile sourcePath & "\*.*" , destinationPath

  Set oFolder = fsoObject.GetFolder(sourcePath)
  Set oFiles = oFolder.Files
  numberOfFiles = oFiles.Count

  For each oFiles in oFiles
   fileNames =  fileNames & vblf &  oFiles.Name
  Next

  If  numberOfFiles <> 0 Then
   Reporter.ReportEvent micWarning, "Clear_Outdir Function", "Function is unable to move the following files:  " & vblf & fileNames
  End If

 On error GoTo 0

 If err.number <> 0 Then
  Reporter.ReportEvent micWarning, "Clear_Outdir Function", "Function gets an error." & vblf & "Error Description: " & err.description & vblf & "Error Number: " & err.number
 End If

End Function


'***Appending data to a text file
 ' Inputs : strFilePath - Path of text file including file name
'   strText - multiple lines of text separated with comma



Public Function func_AppendLine_TextFile(strFilePath,strText)
 'Enable error handling
 On Error Resume Next

 Dim objFSO, objFile

  ' OpenTextFile Method needs a Const value
 Const ForAppending = 8

 'Get multiple lines into an array
 arrText = Split(strText, ",")

 ' Create the File System Object
 Set objFSO = CreateObject("Scripting.FileSystemObject")

 'Create object to append data to file
 Set objFile = objFSO.OpenTextFile(strFilePath, ForAppending, True)

 For index = 0 To UBound(arrText) 
  objFile.WriteLine(arrText(index))
 Next

 'Release objects
 objFile.Close
 Set objFile = nothing

  ' Verify if method executed successfully
 If Err.Number <> 0 Then
  Reporter.ReportEvent micFail, "Error occured in Function- ' <<func_AppendLine_TextFile>>' get failed","Error description: "& Err.Description & vblf & "Error number: " & Err.Number
 End If

 'Disable error handling
 On Error GoTo 0
End Function


'***Deleting data from a text file
 ' Inputs : strFilePath - Path of text file including file name
'   strText - multiple lines of text separated with comma



Public Function func_DeleteLine_TextFile(strFile, strText)
  'Enable error handling
 On Error Resume Next

 'Declare contans & variables
 Const ForReading=1
 Const ForWriting=2
  Dim objFSO,objFile,strLine,strLineCase,strNewFile,flag

 'Initialize objects
 Set objFSO=CreateObject("Scripting.FileSystemObject")
 Set objFile=objFSO.OpenTextFile(strFile,ForReading)

 arrText = Split(strText,",")   'Search record for deletion
 Do Until objFile.AtEndOfStream
  strLine=objFile.Readline
  For index = 0 To UBound(arrText)
   If LCase(Trim(arrText(index))) = LCase(Trim(strLine)) Then
    flag = 1
    Exit For
   Else
    flag = 0
   End If
  Next


  If flag Then
   strNewFile=strNewFile
  Else
   strNewFile=strNewFile&strLine&vbcrlf
  End If
 Loop

 objFile.Close
 Set objFSO=CreateObject("Scripting.FileSystemObject")
 Set objFile=objFSO.OpenTextFile(strFile,ForWriting)
 objFile.Write strNewFile
 'Release object
 objFile.Close
 Set objFile = Nothing
 Set objFSO = Nothing


  ' Verify if method executed successfully
 If Err.Number <> 0 Then
  Reporter.ReportEvent micFail, "Error occured in Function- ' <<func_DeleteLine_TextFile>>' get failed","Error description: "& Err.Description & vblf & "Error number: " & Err.Number
 End If

 'Disable error handling
 On Error GoTo 0
End Function


'***Delete files from an specified directory with given file name (partial file name or exact and not including extension) and extension
' Inputs   :   1)folderPath, 2)fileName 3)fileExt


Public Function   func_DeleteFiles(sDirectoryPath, fileName, fileExt)
 'Enable error handling
 On Error Resume Next

' Declaring objects and variables
 Dim oFSO, oFolder
 Dim oFileCollection, oFile, sDir
 Dim flag

 flag = False

 'Create objects
 Set oFSO = CreateObject("Scripting.FileSystemObject")
 Set oFolder = oFSO.GetFolder(sDirectoryPath)
 Set oFileCollection = oFolder.Files

 'Search for files to be deleted
 For Each oFile In oFileCollection
  If(InStr(oFile.Name,fileName)<>0) And (InStr(oFile.Name,fileExt)<>0) Then
    oFile.Delete(True)
    flag = True
  End If
 Next

' Release objects
 Set oFile = Nothing
 Set oFileCollection = Nothing
 Set oFolder = Nothing
 Set oFSO = Nothing

 'Return boolean value
 func_DeleteFiles = flag
' Verify if method executed successfully
 If Err.Number <> 0 Then
  Reporter.ReportEvent micFail, "Error occured in Function- ' func_DeleteFiles' got failed","Error description: "& Err.Description & vblf & "Error number: " & Err.Number
 End If

 'Disable error handling
 On Error GoTo 0
End Function


'***'Creating a folder if not exist
' Inputs   :   directory path with folder name to be created


Public Function func_CreateFolder(strDirectory)
 Dim objFSO, objFolder

 ' Create the File System Object
 Set objFSO = CreateObject("Scripting.FileSystemObject")

 ' Note If..Exists. Then, Else ... End If construction
 If objFSO.FolderExists(strDirectory) Then
    Set objFolder = objFSO.GetFolder(strDirectory)
 Else
    Set objFolder = objFSO.CreateFolder(strDirectory)
 End If

 'Release object
 Set objFSO = Nothing
 Set objFolder = Nothing

 ' Verify if method executed successfully
 If Err.Number <> 0 Then
  Reporter.ReportEvent micFail, "Error occured in Function- ' func_CreateFolder' got failed","Error description: "& Err.Description & vblf & "Error number: " & Err.Number
 End If

 'Disable error handling
 On Error GoTo 0

End Function

No comments:

Post a Comment