File Functions
These functions and subroutines are great and useful when working with files. One example is creating a log within your program. Simply keep appending your comments to a text stream and finally use the SaveStrToFile function below. This works great when combined with the Sortable Time functions. A file can be created using a timestamp as the file name (ie. 20120313_0406.txt)
GetStreamFromFile
Function GetStreamFromFile (aFileName)
'On Error Resume Next
Const FORREADING = 1
Const TRISTATEFALSE = 0
Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FileExists(aFileName) Then
Err.Description = "File does not exist. " & """" & aFileName & """"
Err.Number = -1
Err.Source = "GetStreamFromFile()"
Err.Raise -1
Exit Function
End If
Dim file: Set file = fso.OpenTextFile(aFileName, FORREADING, TRISTATEFALSE)
Dim fileStream : fileStream = file.ReadAll
Set file = nothing
Set fso = nothing
GetStreamFromFile = fileStream
End Function
SaveStrToFile
Sub SaveStrToFile (aString, aFileName)
On Error Resume Next
Dim textFile
Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
Set textFile = fso.OpenTextFile(aFileName, 2, True, 0)
If Err.Number <> 0 Then
WScript.Echo "Err No: " & Err.Number & vbcrlf & "Description: " & Err.Description
WScript.Echo "Program failed."
WScript.Quit (Err.Number)
End If
textFile.WriteLine aString
textFile.Close
Set textFile = Nothing
Set fso = nothing
End Sub
MoveAllFiles
aSource: Full source path (ie. C:\source\path)
aDestination: Full destination path (ie. C:\destination\path)
aLog: Log string. Useful for logging which files were moved
Sub MoveAllFiles(aSource, aDestination, ByRef aLog)
' Validate parameters
If (aSource = vbEmpty) Then
WScript.Echo "ERROR: Source path is empty"
End If
If (aDestination = vbEmpty) Then
WScript.Echo "ERROR: Destination path is empty"
End If
On Error Resume Next
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim folder : Set folder = fso.GetFolder(aSource)
Dim file
Dim DestinationLeadingBackStash : DestinationLeadingBackStash = ""
Dim tempDestinationFullPath : tempDestinationFullPath = ""
Dim Count : Count = 0
If (Right(aDestination, 1) = "\") Then
DestinationLeadingBackStash = ""
Else
DestinationLeadingBackStash = "\"
End If
Dim fileCol : Set fileCol = folder.Files
For Each file in fileCol
tempDestinationFullPath = aDestination & DestinationLeadingBackStash & file.Name
'Move only if does not exist in the destination
If Not fso.FileExists(tempDestinationFullPath) Then
' Wait for process
If Count Mod 2000 = 0 Then
WScript.Sleep 500
End If
file.Move aDestination & DestinationLeadingBackStash
If Err.Number <> 0 Then
aLog = aLog & "ERROR: Unable to move file: " & file.Name & vbNewLine & _
Err.Number & ": " & Err.Description & vbNewLine
Else
aLog = aLog & file.Name & vbNewLine
Count = Count + 1
End If
End If
Next
aLog = aLog & "Files Moved: " & Count & vbNewLine
If folder.Count > 0 Then
aLog = aLog & "Error: Not all files were moved." & vbNewLine & _
"Remaining file count: " & folder.Count & vbNewLine
End If
Set file = nothing
Set folder = nothing
Set fso = nothing
End Sub
MapNetworkDrive
Sub MapNetworkDrive (aDriveLetter, aStrRemoteShare, aPersistentFlag, aStrUser, aStrPassword)
On Error Resume Next
Dim objNetwork : Set objNetwork = CreateObject("WScript.Network")
objNetwork.MapNetworkDrive aDriveLetter, aStrRemoteShare, aPersistentFlag, aStrUser, aStrPassword
If Err.Number = -2147023677 Then
WScript.Echo objNetwork.MapNetworkDrive (aDriveLetter, aStrRemoteShare, aPersistentFlag)
Exit Sub
End If
If Err.Number <> 0 Then
WScript.Echo "Error: " & Err.Number & vbNewLine & Err.DESCRIPTION
Exit Sub
End If
Set objNetwork = nothing
End Sub
GetFileName
Function GetFileName(aFileName)
Dim fso, file, retval
Set fso = CreateObject("Scripting.FileSystemObject")
Set file = fso.GetFile(aFileName)
retval = file.Name
Set file = nothing
Set fso = nothing
GetFileName = retval
End Function
