MultiFunct

Attribute VB_Name = "File1"
'INDEX

'(Note: the string Functions are Required for some of the File Subs)

'BetweenText [Function] (ERROR)

'CopyDir

'CopyFile

'DeleteDir (Not Drive)

'DeleteFile

'ExtractText [Function]

'FileSize [Function] MB is Off a Little

'FileRepExists [Function]

'FindChar [Function]

'GetDirs

'MakeDir

'MoveDir

'MoveFile

'RenamePath (For Files and Directories!!)

'SearchNReplace [Function]

Enum SizeX
BytesX
kilobytesX
MegaBytesX
GigaBytesX
End Enum
Public XDir(2) As New Collection
Option Explicit
'Creates a Directory

Public Sub MakeDir(path As String)
On Error Resume Next
Dim NewDirectoryName As String
NewDirectoryName = InputBox$("Create Directory at " _
& path, "Create Directory", "New")
If NewDirectoryName = "" Then Exit Sub
'Adjusts For the MkDir (path & "\" & NewDirectoryName)

If Right$(path, 1) <> "\" Then
Else
MkDir (path & NewDirectoryName)
End If
End Sub

'Renames Files

Public Sub RenamePath(OldPath As String, NewPath As String)
On Error Resume Next
Name OldPath As NewPath
End Sub

'Copies File From One Area to Another

'To Use: CopyFile FromPath, ToPath

Public Sub CopyFile(FromPath As String, ToPath As String)
On Error Resume Next
FileCopy FromPath, ToPath
End Sub

'Moves File From One Location to Another

Public Sub MoveFile(OldPath As String, NewPath As String)
On Error Resume Next
If OldPath = NewPath Then
MsgBox "Cannot MOVE a File to the Same Directory!", _
vbOKOnly, "Cannot Move to Same Directory!"
Exit Sub'!!!Prevents an ERROR!!!
End If
FileCopy OldPath, NewPath
Kill OldPath'Moves File
End Sub

'Deletes File

Public Sub DeleteFile(path As String)
On Error Resume Next
Beep
If MsgBox("Are you Sure you want to Delete " _
& path, vbOKCancel, "Delete") = 1 Then
Kill path'Deletes File
End If
End Sub

Public Function FileSize(FileName As String, SizeIn As SizeX) As String
Select Case SizeIn
Case 0 'Bytes
FileSize = Format$(FileLen(FileName), "###,###,###") & " Bytes"
Case 1 'KB
FileSize = Format$(FileLen(FileName) / 1024, _
"###,###,###.0") & " KB"
Case 2 'MB
FileSize = Format$(FileLen(FileName) / 1048 / 1000, _
"###,###,###.0") & " MB"
Case 3 'GB
End Select
End Function

'Deletes Full Directories (Not Drives)

Public Sub DeleteDir(path$)
On Error Resume Next
Dim vDirName As String, LastDir As String
Dim z As New Collection, i As Integer
'Adjust so No Deletion of Drive

If Len(path$) < 4 Then Exit Sub
Screen.MousePointer = vbHourglass
If Right(path$, 1) <> "\" Then path$ = path$ & "\"
vDirName = Dir(path, vbDirectory)' Retrieve the first entry.
z.Add Mid(path$, 1, Len(path$) - 1)
Do While vDirName <> ""
If vDirName <> "." And vDirName <> ".." Then
If (GetAttr(path & vDirName)) = vbDirectory Then
LastDir = vDirName
'Finds Directory Name then Repeats

DeleteDir (path$ & vDirName)
vDirName = Dir(path$, vbDirectory)
Do Until vDirName = LastDir Or vDirName = ""
vDirName = Dir
Loop
If vDirName = "" Then Exit Do
End If
End If
vDirName = Dir
Loop
Screen.MousePointer = vbDefault
For i = 1 To z.Count
'Deletes Files In Directories

Kill z.Item(i) & "\*.*"
'Deletes the Directories

RmDir (z.Item(i))
Next
End Sub

'Used for CopyDir and MoveDir

Public Sub GetDirs(path$)
On Error Resume Next
Dim vDirName As String, LastDir As String
Dim i As Integer
'Adjust so No Deletion of Drive

If Len(path$) < 4 Then Exit Sub
Screen.MousePointer = vbHourglass
If Right(path$, 1) <> "\" Then
XDir(0).Add ExtractText(path$, ":", False, False)
path$ = path$ & "\"
End If
vDirName = Dir(path, vbDirectory) ' Retrieve the first entry.
Do While vDirName <> ""
If (GetAttr(path & vDirName)) <> vbDirectory Then
Select Case vDirName
Case Is = ".", "..", "\"
Case Else
XDir(1).Add path & vDirName
XDir(2).Add ExtractText(path$ & vDirName, ":", False, False)
End Select
End If
If vDirName <> "." And vDirName <> ".." Then
If (GetAttr(path & vDirName)) = vbDirectory Then
LastDir = vDirName
'Finds Directory Name then Repeats

GetDirs (path$ & vDirName)
vDirName = Dir(path$, vbDirectory)
= False And IncludeLeftSide = False Then
ExtractText = ""
For i = Len(FullText) To 1 Step -1
If Mid(FullText, i, 1) = token Then
ExtractText = Right(FullText, Len(FullText) - i)
Exit Function
End If
Next
End If
End Function

'Move Directory Correctly

Public Sub MoveDir(FromPath As String, ToPath As String)
On Error Resume Next
CopyDir FromPath, ToPath
DeleteDir FromPath
End Sub

Public Function FileRepExists(path As String) As Boolean
Dim val As Integer
On Error Resume Next
val = GetAttr(path)
FileRepExists = IIf(Err = 0, True, False)
End Function

sts = IIf(Err = 0, True, False)
End Function