Public Sub restoreDB()
 
        Dim backupName As String
        Dim portfolioDBName As String = portfolioDBPath + "portfolioDB.mdb"
 
        Dim fdlg As OpenFileDialog = New OpenFileDialog()
 
        fdlg.InitialDirectory = portfolioDBPath + "\backup"
 
        If fdlg.ShowDialog() = Windows.Forms.DialogResult.OK Then
            backupName = fdlg.FileName
 
            If MessageBox.Show("Restoring the database will erase any changes you have made since your last backup. Are you sure you want to do this?", _
            "Confirm Delete", _
            MessageBoxButtons.OKCancel, _
            MessageBoxIcon.Question, _
            MessageBoxDefaultButton.Button2) = Windows.Forms.DialogResult.OK Then
                'Restore the database from a backup copy.
                FileCopy(backupName, portfolioDBName)
 
                MsgBox("Database Restoration Successful")
            End If
        End If
 
    End Sub

Public mpProgPath as String

 mpProgPath = GetSetting("My Program", "StartUpValues", "AppPath", cstr(App.path))

strDB_PATH =  mpProgPath & "\db"
strImage_Path = mpProgPath & "\Images"

Dim objFSO, objFolder, objShell, objTextFile, objFile
Dim strDirectory, strFile, strText
strDirectory = "d:\gb nair"
strFile = "\Summer.txt"
strText = "Book Another Holiday"
 
' Create the File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
 
' Check that the strDirectory folder exists
If objFSO.FolderExists(strDirectory) Then
   Set objFolder = objFSO.GetFolder(strDirectory)
Else
   Set objFolder = objFSO.CreateFolder(strDirectory)
   WScript.echo "Just created " & strDirectory
End If
 
If objFSO.FileExists(strDirectory & strFile) Then
   Set objFolder = objFSO.GetFolder(strDirectory)
Else
   Set objFile = objFSO.CreateTextFile(strDirectory & strFile)
   WScript.echo "Just created " & strDirectory & strFile
End If
 
Set objFile = Nothing
Set objFolder = Nothing
' OpenTextFile Method needs a Const value
' ForAppending = 8 ForReading = 1, ForWriting = 2
Const ForAppending = 8
 
Set objTextFile = objFSO.OpenTextFile _
(strDirectory & strFile, ForAppending, True)
 
' Writes strText every time you run this VBScript
objTextFile.WriteLine (strText)
objTextFile.Close
 
' Bonus or cosmetic section to launch explorer to check file
If Err.Number = vbEmpty Then
   Set objShell = CreateObject("WScript.Shell")
   objShell.Run ("Explorer" & " " & strDirectory & "\")
Else: WScript.echo "VBScript Error: " & Err.Number
End If
 
WScript.Quit

Private Sub cmdFiles_Click()
MsgBox GetDBLocation
End Sub
 
Private Function GetDBLocation() As String
Dim strDBLocation As String
Dim fso As New FileSystemObject
Dim fldrs As Folder
Dim fldr As Folder
Dim fle As File
Set fldrs = fso.GetFolder("C:\Program Files")
For Each fldr In fldrs.SubFolders
For Each fle In fldr.Files
If fle.ShortName = "YOUR DB NAME" Then
strDBLocation = fle.Name
Goto ExitHere
End If
Next fle
Next fldr
ExitHere:
Set fldrs = Nothing
Set fso = Nothing
If Len(strDBLocation) > 0 Then
GetDBLocation = strDBLocation
Else
GetDBLocation = "Oops! Can't find the DB"
End If
End Function