Disable Startup Programmatically

M

mattyMacro

Is it possible to Programmatically open an Access database while bypassing
the startup?

Basically I need the VBA equivilent of holding the Shift Key.

I can definitely get into the nuts and bolts of the issue further but the
general overview is that I am writing a version control module. It checks to
see if there is a new version avaliable and the path to the newest version
from an external Db on startup. If obsolete it creates and runs an
executable that saves the obsolete db as a new name then copies the new
version into the same folder. It then opens the new version and runs a sub
(within the new version) that copies all applicable tables from old Db to
new.

The whole process works fine except when the new db opens I don't want it to
open the startup forms as I want this version control to work on all
databases regurdless on what happens at startup.
 
M

mattyMacro

See code below:


Option Compare Database
Option Explicit
Public Const MACRONAME = "Trial Access Database"
Public Const MACROVER = "1.000"
Public Const MACRODATE = "2/28/2010"
Public Const MACROBY = "VirtualIT"
Public Const VPATH = "ServerName"
Public Const VDRIVE = "\FolderName\"
Public Const VERSIONDB = "VersionControl.mdb"

Public Sub CheckVersion()
Dim strSQL As String
Dim cnnConn As New ADODB.Connection
Dim rstVersion As New ADODB.Recordset
Dim OldFile As String
Dim NewFile As String
Dim CurrPath As String
Dim MacroFile As String
Dim fs As Object

'//Connects to Version Control Database
With cnnConn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0"
.Open "\\" & VPATH & VDRIVE & VERSIONDB
End With

'//Retrieves Recordset matching the constant MACRONAME
With rstVersion
.CursorType = adOpenForwardOnly
.LockType = adLockReadOnly
.Open "SELECT * FROM tblVersion WHERE MacroName = '" & MACRONAME &
"'", cnnConn
If .EOF Then
MsgBox ("Macro does not exist in database, please email VirtualIT
for assistance.")
Exit Sub
Else

'//Compares the constant MACROVER to the corresponding Version
Number saved in
'the Version control Db
If .Fields("VersionNumber") <> MACROVER Then

'//Informs user that there is a newer version available
MsgBox ("A new version of this macro is available." & vbNewLine
& vbNewLine & _
"Version: " & .Fields("VersionNumber") & " Released: " &
..Fields("ReleaseDate") & "." & _
vbNewLine & vbNewLine & "Please click OK to continue update.")

'//Saves the obsolete Db as Filename_old_MMDDYYYY
Set fs = CreateObject("Scripting.FileSystemObject")
MacroFile = .Fields("MacroPath") & .Fields("MacroFileName")
OldFile = CurrentProject.Name
CurrPath = CurrentProject.path & "\"
NewFile = Mid(OldFile, 1, Len(OldFile) - 4) & "_old_" &
Format(Date, "mmddyyyy") & ".mdb"
fs.copyfile CurrPath & OldFile, CurrPath & NewFile


Call CreateBat(MacroFile, CurrPath & OldFile)
Call CreateVbs(CurrPath, OldFile, NewFile)

MsgBox ("A copy is saved to " & CurrPath & NewFile & vbNewLine &
vbNewLine & _
"Please allow update to finish and new version will open.")


Shell "C:\Temp\CTSGUpdate.bat", vbMaximizedFocus
DoCmd.Quit
End If
End If
.Close
End With
End Sub

Public Sub CreateBat(MacroFile As String, OldFile As String)
Dim FileNum%
FileNum = FreeFile()
Open "C:\Temp\Update.bat" For Output As #FileNum
Print #FileNum, "ECHO Please wait for update to complete..."
Print #FileNum, "@ECHO OFF"
Print #FileNum, "ping -n 5 127.0.0.1 >nul"
Print #FileNum, "ECHO ON"

'//Copy current version of Db to obsolete version file path
Print #FileNum, "XCopy " & Chr$(34) & MacroFile & Chr$(34) & " " &
Chr$(34) & OldFile & Chr$(34) & " /Y"

'//Run C:\Temp\Update.vbs
Print #FileNum, Chr$(34) & "C:\Temp\Update.vbs" & Chr$(34)
Close #FileNum
End Sub

Public Sub CreateVbs(CurrPath As String, OldFile As String, NewFile As String)
Dim FileNum%
FileNum = FreeFile()
Open "C:\Temp\Update.vbs" For Output As #FileNum
Print #FileNum, "Set appAccess = CreateObject(" & Chr$(34) &
"Access.Application" & Chr$(34) & ")"

'//Sets Access security
Print #FileNum, "appAccess.AutomationSecurity = 1"


THIS IS WHERE SOMETHING NEEDS TO BE ADDED SO THAT NO EVENTS RUN UNTIL AFTER
THE TABLES HAVE BEEN UPDATED

'//Opens the current version of the database
Print #FileNum, "appAccess.OpenCurrentDatabase (" & """" & CurrPath &
OldFile & """" & ")"

'//Runs Update subroutine from new Db
Print #FileNum, "appAccess.Run " & Chr$(34) & "Update" & Chr$(34) & ", "
& Chr$(34) & CurrPath & Chr$(34) & ", " & Chr$(34) & NewFile; Chr$(34)

Close #FileNum
End Sub
Private Const TABLES_TO_UPDATE As String = "tbl_test1,tbl_test2,tbl_test3,"



Sub Update(OldPath As String, OldFile As String)
'//Copies all tables from old Db to new db

DoCmd.SetWarnings False

Dim lngStartChr As Long
Dim strUpdateTaleList As String
Dim strUpdateTableName As String

lngStartChr = 1
strUpdateTaleList = Trim(TABLES_TO_UPDATE)
If Right(Trim(strUpdateTaleList), 1) <> "," Then strUpdateTaleList =
strUpdateTaleList & ","
Do Until InStr(lngStartChr, strUpdateTaleList, ",") < 1
strUpdateTableName = Trim(Mid(Trim(strUpdateTaleList), lngStartChr,
InStr(lngStartChr, strUpdateTaleList, ",") - lngStartChr))
If Trim(strUpdateTableName) <> "" Then
DoCmd.RunSQL "SELECT * INTO " & Trim(strUpdateTableName) & "
FROM " & Trim(strUpdateTableName) & " IN '" & OldPath & OldFile & "'"
End If
lngStartChr = InStr(lngStartChr, strUpdateTaleList, ",") + 1
Loop



DoCmd.SetWarnings True
DoCmd.OpenForm ("frm_Start") '//Now open the form that should open on Startup

MsgBox ("Macro updated to version " & MACROVER & ". If you are not
expecting this update, please contact VirtualIT immediately.")
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top