- Local time
- Today, 23:48
- Joined
- Sep 12, 2006
- Messages
- 15,956
What code are you using to create the accde file?
Public Function MakeACCDE(InPath As String, OutPath As String)
Dim App As Access.Application
Set App = New Access.Application
App.AutomationSecurity = 1 'msoAutomationSecurityLow
App.SysCmd 603, InPath, OutPath
Set App = Nothing
End Function
...
DummyPath = CurrentProject.Path & "\" & "Dummy.accdb"
' We need to make a copy of the db for the accde vba code to work. Will not work on current DB
Set FSO = CreateObject("Scripting.FileSystemObject")
'Pause (40)
If FSO.FileExists(DummyPath) Then
MsgBox "Exists"
Else
MsgBox "Does Not Exist"
End If
Exit Sub
FSO.CopyFile CurrentDBPath, DummyPath
...
Gemma - here is what I am experiencing - maybe it will help both of us!!!That's the code I have. I've never tried to build an accde in code before. The database I was using actually opens a connection form to select and connect to a choice of back ends. The syscmd line ran, but didn't create the .accde in the correct folder. I don't know if my quit line might have deleted the saved .accde. I'll comment that out to see.
Also - could you reply to the end of R20 about checking the .accde file creation date.
Private Sub btnACCDE_Click()
' https://www.access-programmers.co.uk/forums/threads/f11-disable-or-not.328822/
' https://www.access-programmers.co.uk/forums/threads/three-timer-questions.329391/
Dim CurrentDBPath, DummyPath As String, OutPath As String
Dim FSO As Object
Dim FSOFile As Object
Dim TStamp As Date
Dim IElapsed As Integer
On Error GoTo ErrHandler
strResult = Dialog.Box(Prompt:="Did you do a Decompile and Compact and Repair?\n\nClicking No will cancel .ACCDE File creation." & "", Buttons:=(4 + 32))
If strResult = vbNo Then
'MsgBox "I'm Done"
Exit Sub
End If
Screen.MousePointer = 11
DoCmd.OpenForm "frmTimerProgressBar"
With Forms![frmTimerProgressBar]
.LabelCaption.caption = "Creating .ACCDE File"
'.CycleDuration sets how long it takes the Progess Bar to complete (in 1/10-seconds). Default of 600 takes 60 seconds. 50 would take 5 seconds.
.CycleDuration = 30
.cmdStart_Click
End With
CurrentDb.Properties("AllowSpecialKeys").value = False
'save and compile all modules - https://isladogs.co.uk/compile-modules/index.html
Application.SysCmd 504, 16483
CurrentDBPath = CurrentProject.Path & "\" & CurrentProject.Name
DummyPath = CurrentProject.Path & "\" & "Dummy.accdb"
' We need to make a copy of the db for the accde vba code to work. Will not work on current DB
Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.CopyFile CurrentDBPath, DummyPath
TStamp = Now()
' Loop below is not required.
'Do Until FSO.FileExists(DummyPath)
' IElapsed = DateDiff("s", TStamp, Now())
' If IElapsed > 60 Then
' MsgBox IElapsed
' Exit Do
' End If
' DoEvents
'Loop
OutPath = Replace(CurrentDBPath, "accdb", "accde")
' 40 does not give errors. 3 Works sometimes. 2 Fails Sometimes. MB
Pause (3)
Call MakeACCDE(DummyPath, OutPath)
FSO.DeleteFile DummyPath
DoCmd.Close acForm, "frmTimerProgressBar", acSaveNo
Screen.MousePointer = 1
If FSO.FileExists(OutPath) Then
Set FSOFile = FSO.GetFile(OutPath)
If FSOFile.DateCreated > TStamp Then
Box "ACCDE created as " & OutPath
Else
Box "Something went wrong! ACCDE file was not created."
End If
Else
Box "Something went wrong! ACCDE file was not created."
End If
CurrentDb.Properties("AllowSpecialKeys").value = True
ExitSub:
Set FSOFile = Nothing
Set FSO = Nothing
Err_Exit:
Exit Sub
ErrHandler:
MsgBox "Error " & Err.Number & " " & Err.DESCRIPTION
Resume ExitSub
End Sub