'Create a disconnected recordset
Function CreateDisconnectedRecordset()
	Dim RS
	Set RS = CreateObject("ADODB.Recordset")
	RS.CursorLocation = 3 'adUseClient
	Set RS.ActiveConnection = Nothing
	RS.CursorType = 3 'adOpenStatic
	RS.LockType = 3 'adLockBatchOptimistic
	Set CreateDisconnectedRecordset = RS
End	Function


'Retrieve a folder's contents as a disconnected recordset
Function GetFolderAsRecordset(FolderPath)
	Dim FSO, Folder, SubFolders, Files, F, RS, FileSize

	On Error Resume Next
	
	Set FSO = CreateObject("Scripting.FileSystemObject")
	If FSO.FolderExists(FolderPath) Then
		'Disable error handling so that restricted folders don't crash the script
		'(no other way to handle them with the FSO)
		
		Set RS = CreateDisconnectedRecordset()
		RS.Fields.Append "Type", 200, 10 'adVarChar
		RS.Fields.Append "Name", 200, 255 'adVarChar
		RS.Fields.Append "Extension", 200, 255 'adVarChar
		RS.Fields.Append "Created", 135 'adDBTimeStamp
		RS.Fields.Append "Modified", 135 'adDBTimeStamp
		RS.Fields.Append "Size", 19, ,32 'adUnsignedInt
		RS.Fields.Append "AccessDenied", 11 'adBoolean
		RS.Open
		
		Set Folder = FSO.GetFolder(FolderPath)

		For Pass = 1 To 2
			If Pass = 1 Then
				Set Collection = Folder.SubFolders
				FType = "Folder"
			Else
				Set Collection = Folder.Files
				FType = "File"
			End If
			
			For Each F In Collection
				RS.AddNew
				RS("Type") = FType
				RS("Name") = F.Name
				RS("Extension") = LCase(GetFileExtension(F.Name))
				RS("Created") = F.DateCreated
				RS("Modified") = F.DateLastModified
				
				'This might throw an error if the FSO can't access the folder
				FileSize = F.Size
				
				Select Case Err.Number
					Case 0 'Ok
						RS("AccessDenied") = False
						RS("Size") = FileSize
					
					Case 70	'Permission denied
						RS("AccessDenied") = True
						RS("Size") = Null
					
					Case Else
						RS("AccessDenied") = False
						RS("Size") = Null
				End Select
	
				Err.Clear
			Next
		Next
		
		Set F = Nothing
		Set Collection = Nothing
		Set FSO = Nothing
		
		'Sort into alphabetic order, folders first
		RS.Sort = "Type DESC, Name ASC"
		Set GetFolderAsRecordset = RS
	Else
		Set GetFolderAsRecordset = Nothing
	End If

	On Error GoTo 0
End Function


'Retrieve the extension from a filename/filepath
Function GetFileExtension(Filename)
	Dim ExtPos
	ExtPos = InStrRev(Filename, ".")

	If (ExtPos > 0) Then
		GetFileExtension = Mid(Filename, ExtPos + 1)
	Else
		GetFileExtension = ""
	End If
End Function


'Check whether a file (or folder) exists
Function FileExists(FilePath)
	If Right(FilePath) = "\" Then
		FileExists = CreateObject("Scripting.FileSystemObject").FolderExists(FilePath)
	Else	
		FileExists = CreateObject("Scripting.FileSystemObject").FileExists(FilePath)
	End If
End Function


'Create a folder
Sub CreateFolder(Path)
	CreateObject("Scripting.FileSystemObject").CreateFolder(Path)
End Sub


'Move a file
Sub MoveFile(ByVal Source, ByVal Destination)
	Call CreateObject("Scripting.FileSystemObject").MoveFile(Source, Destination)
End Sub


'Copy a file
Sub CopyFile(ByVal Source, ByVal Destination)
	Call CreateObject("Scripting.FileSystemObject").CopyFile(Source, Destination)
End Sub


'Delete a file
Sub DeleteFile(ByVal FilePath)
	If FileExists(FilePath) Then
		Call CreateObject("Scripting.FileSystemObject").CopyFile(Source, Destination)
	End If
End Sub


'Rename a file
Function RenameFile(OldFilePath, NewFilePath)
	On Error resume next

	Call DeleteFile(NewFilePath)
	
	Call MoveFile(OldFilePath, NewFilePath)
	
	If Err.Number <> 0 Then
		RenameFile = False
	Else
		RenameFile = True
	End If
End Function