ProgEvalJAA
MIS
I'm trying to change the maxcro this code runs just slightly.
This macro is attached to a switchboard button.
Right now it creates a backup copy of my database on the current drive of the database. I want the backup to be created on their flash drive and pop up an error message if the flash drive is not plugged in at the time. Does anyone have any thoughts? Below is all my code.
Option Compare Database
Option Explicit
Private dbs As DAO.Database
Private fld As DAO.Field
Private flds As DAO.Fields
Private frm As Access.Form
Private fso As Scripting.FileSystemObject
Private intDayNo As Integer
Private intExtLength As Integer
Private intExtPosition As Integer
Private intLength As Integer
Private intReturn As Integer
Private lngCount As Long
Private prp As DAO.Property
Private prps As DAO.Properties
Private rst As DAO.Recordset
Private sfld As Scripting.Folder
Private strBackupPath As String
Private strCurrentDB As String
Private strDBName As String
Private strPath As String
Private strDayPrefix As String
Private strExtension As String
Private strFieldName As String
Private strForm As String
Private strMessage As String
Private strNextNo As String
Private strPrompt As String
Private strPropName As String
Private strProposedSaveName As String
Private strQuery As String
Private strSaveName As String
Private strSourceObject As String
Private strSQL As String
Private strTitle As String
Private tdf As DAO.TableDef
Private tdfs As DAO.TableDefs
Private varPropValue As Variant
Public Function BackupFrontEnd()
' Created by Helen Feddema 3-Sep-2006
' Modified by Helen Feddema 16-Sep-2006
On Error GoTo ErrorHandler
Set dbs = CurrentDb
Set tdfs = dbs.TableDefs
Set fso = CreateObject("Scripting.FileSystemObject")
strCurrentDB = Application.CurrentProject.Name
Debug.Print "Current db: " & strCurrentDB
intExtPosition = InStr(strCurrentDB, ".")
strExtension = Mid(strCurrentDB, intExtPosition)
intExtLength = Len(strExtension)
' Create backup path string (Backups folder under database folder)
strBackupPath = Application.CurrentProject.Path & "\Backups\"
Debug.Print "Backup path: " & strBackupPath
' Check whether path is valid
On Error Resume Next
Set sfld = fso.GetFolder(strBackupPath)
If sfld Is Nothing Then
' Create folder
Set sfld = fso.CreateFolder(strBackupPath)
End If
On Error GoTo ErrorHandler
' Create proposed save name for backup
strSaveName = Left(strCurrentDB, Len(strCurrentDB) - intExtLength) & " Copy " & SaveNo & ", " & strDayPrefix & strExtension
strSaveName = Left(strCurrentDB, Len(strCurrentDB) - intExtLength) & "-" & strDayPrefix & strExtension
strProposedSaveName = strBackupPath & strSaveName
Debug.Print "Backup save name: " & strProposedSaveName
strTitle = "Database Backup"
strPrompt = "Save database to " & strProposedSaveName & "?"
strSaveName = Nz(InputBox(prompt:=strPrompt, TITLE:=strTitle, Default:=strProposedSaveName))
' Deal with user canceling out of the InputBox
If strSaveName = "" Then
GoTo ErrorHandlerExit
End If
' 12/08/08 Not needed if we don't use a copy number in the file name
' Set rst = dbs.OpenRecordset("tblBackupInfo")
' With rst
' .AddNew
' ![SaveDate] = Format(TitheSunday(), "yyyy-mm-dd")
' ![SaveNumber] = SaveNo
' .Update
This macro is attached to a switchboard button.
Right now it creates a backup copy of my database on the current drive of the database. I want the backup to be created on their flash drive and pop up an error message if the flash drive is not plugged in at the time. Does anyone have any thoughts? Below is all my code.
Option Compare Database
Option Explicit
Private dbs As DAO.Database
Private fld As DAO.Field
Private flds As DAO.Fields
Private frm As Access.Form
Private fso As Scripting.FileSystemObject
Private intDayNo As Integer
Private intExtLength As Integer
Private intExtPosition As Integer
Private intLength As Integer
Private intReturn As Integer
Private lngCount As Long
Private prp As DAO.Property
Private prps As DAO.Properties
Private rst As DAO.Recordset
Private sfld As Scripting.Folder
Private strBackupPath As String
Private strCurrentDB As String
Private strDBName As String
Private strPath As String
Private strDayPrefix As String
Private strExtension As String
Private strFieldName As String
Private strForm As String
Private strMessage As String
Private strNextNo As String
Private strPrompt As String
Private strPropName As String
Private strProposedSaveName As String
Private strQuery As String
Private strSaveName As String
Private strSourceObject As String
Private strSQL As String
Private strTitle As String
Private tdf As DAO.TableDef
Private tdfs As DAO.TableDefs
Private varPropValue As Variant
Public Function BackupFrontEnd()
' Created by Helen Feddema 3-Sep-2006
' Modified by Helen Feddema 16-Sep-2006
On Error GoTo ErrorHandler
Set dbs = CurrentDb
Set tdfs = dbs.TableDefs
Set fso = CreateObject("Scripting.FileSystemObject")
strCurrentDB = Application.CurrentProject.Name
Debug.Print "Current db: " & strCurrentDB
intExtPosition = InStr(strCurrentDB, ".")
strExtension = Mid(strCurrentDB, intExtPosition)
intExtLength = Len(strExtension)
' Create backup path string (Backups folder under database folder)
strBackupPath = Application.CurrentProject.Path & "\Backups\"
Debug.Print "Backup path: " & strBackupPath
' Check whether path is valid
On Error Resume Next
Set sfld = fso.GetFolder(strBackupPath)
If sfld Is Nothing Then
' Create folder
Set sfld = fso.CreateFolder(strBackupPath)
End If
On Error GoTo ErrorHandler
' Create proposed save name for backup
strSaveName = Left(strCurrentDB, Len(strCurrentDB) - intExtLength) & " Copy " & SaveNo & ", " & strDayPrefix & strExtension
strSaveName = Left(strCurrentDB, Len(strCurrentDB) - intExtLength) & "-" & strDayPrefix & strExtension
strProposedSaveName = strBackupPath & strSaveName
Debug.Print "Backup save name: " & strProposedSaveName
strTitle = "Database Backup"
strPrompt = "Save database to " & strProposedSaveName & "?"
strSaveName = Nz(InputBox(prompt:=strPrompt, TITLE:=strTitle, Default:=strProposedSaveName))
' Deal with user canceling out of the InputBox
If strSaveName = "" Then
GoTo ErrorHandlerExit
End If
' 12/08/08 Not needed if we don't use a copy number in the file name
' Set rst = dbs.OpenRecordset("tblBackupInfo")
' With rst
' .AddNew
' ![SaveDate] = Format(TitheSunday(), "yyyy-mm-dd")
' ![SaveNumber] = SaveNo
' .Update