Senin, 20 Mei 2013

[MS_AccessPros] Re: front end to compact and repair back end

 

Liz

What do you mean it doesn't free up the back end? For one thing, if you have a recordset open or any other connections you have to close them before compacting. Could that be your problem? I don't see any evidence of that in your code, but I know that's not the whole picture.

Regards,
Bill Mosca, Founder - MS_Access_Professionals
http://www.thatlldoit.com
Microsoft Office Access MVP
https://mvp.support.microsoft.com/profile=C4D9F5E7-BB03-4291-B816-64270730881E
My nothing-to-do-with-Access blog
http://wrmosca.wordpress.com

--- In MS_Access_Professionals@yahoogroups.com, Liz Ravenwood <liz_ravenwood@...> wrote:
>
> Pros, I'm wanting to have a front end compact and repair a back end if they are the first to log on on a Sunday morning. Attached is some code... (probably not looking at Sunday cause I'm playing with test files and NOT on a Sunday...)
>
> Everything works. It does a compact and repair, but the problem is that it doesn't free up the back end it just did the compact and repair on. It's probably simple, but I don't know what I'm supposed to do.
>
> Ideas?
>
> Public Function NeedToRunCompactNRepairBE() As Boolean
> st1: ' determine if today is Sunday
> 'Exit Sub
> Dim intWkDay As Integer
> Dim booSun As Boolean
> Dim strsql As String
> intWkDay = DatePart("w", Now()) ' 1 is Sunday
> If intWkDay = 3 Then
> Dim strThen As String
> Dim strToday As String
> Dim rs As DAO.Recordset
> strToday = CStr(Format(Date, "mm/dd/yy"))
> strsql = "SELECT Max(TimeLoggedIn) FROM LogStats WHERE WhichDatabase = 'ECR DB'"
> Set rs = CurrentDb.OpenRecordset(strsql)
> strThen = CStr(Format(rs.Fields(0).Value, "mm/dd/yy"))
> If strToday <> strThen Then
> NeedToRunCompactNRepairBE = True
> Else
> NeedToRunCompactNRepairBE = False
> End If
> Set rs = Nothing
> End If
> End Function
>
> Public Sub CompactNRepairBE(strForm As String)
> On Error GoTo Rollback
>
> Dim fso As Object
> Dim lngFullSize As Long
> Dim strsql As String
> Dim strBE As String
> Dim strBEnew As String
> Dim strUser As String
> Dim strBackup As String
> strUser = GetLoginName()
> st0: ' determine back end paths
> strBE = "\\ws0415\tudb$\ECR_be-test.accdb"
> strBEnew = "\\ws0415\tudb$\ECR_be-new.accdb"
> strBackup = "\\ws0415\tudb$\ECR_be-backup.accdb"
> st1: ' get previous file size
> ' MsgBox ("...performing necessary maintenance... This will take a few seconds.")
> lngFullSize = CDec(FileLen(strBE)) / 1024
> strsql = "INSERT INTO DBMaint VALUES (#" & Now() & "#, 'Pre-compact: " & strUser & "', " & lngFullSize & ");"
> CurrentDb.Execute (strsql)
> st2: ' close the current form
> DoCmd.Close acForm, strForm
> st3: ' compact the back end
> Set fso = CreateObject("Scripting.FileSystemObject")
> On Error Resume Next
> Kill strBackup
> On Error GoTo Rollback
> fso.CopyFile strBE, strBackup
> DBEngine.CompactDatabase strBE, strBEnew
> fso.DeleteFile strBE
> fso.movefile strBEnew, strBE
> st4: ' close the back end (compact and repair upon close)
> lngFullSize = CDec(FileLen(strBE)) / 1024
> strsql = "INSERT INTO DBMaint VALUES (#" & Now() & "#, 'Post-compact: " & strUser & "', " & lngFullSize & ");"
> CurrentDb.Execute (strsql)
> st5: ' reopen the current form
> CurrentDb.Execute "INSERT INTO LogStats (UserLoggedIn, TimeLoggedIn, WhichDatabase) " & _
> "VALUES('" & strUser & "-compacted" & "', #" & Now() & "#, 'ECR DB')"
> GoTo exitout
> Rollback: ' don't care if this fails because the back end already exists, but in case it is gone we want to copy the backup back
> If Err.Number = 3704 Then ' the back end is already opened and cannot be compacted
> GoTo exitout
> Else
> On Error Resume Next
> fso.movefile strBackup, strBE
> End If
> exitout:
> Set fso = Nothing
> DoCmd.OpenForm strForm
> End Sub
>
> Respectfully,
> Liz Ravenwood
> Programmer/Analyst
> Super First Class Products
> B/E Aerospace
> O: 1.520.239.4808
> www.beaerospace.com<http://www.beaerospace.com>
>
> This email (and all attachments) is for the sole use of the intended recipient(s) and may contain privileged and/or proprietary information. Any unauthorized review, use, disclosure or distribution is prohibited. If you are not the intended recipient, please contact the sender by reply e-mail and destroy all copies of the original message.
>
>
> [Non-text portions of this message have been removed]
>

__._,_.___
Reply via web post Reply to sender Reply to group Start a New Topic Messages in this topic (4)
Recent Activity:
.

__,_._,___

Tidak ada komentar:

Posting Komentar