CompactRepair VBA Problem

R

ramez75

Registered User.
Local time
Today, 05:35
Joined
Dec 23, 2008
Messages
181
Hi

I am having a problem using the below code that I found somewhere using GOOGLE......I am not getting any error. I wanted to modify the below vba to not only compact&repair but to also move the database to another folder

Code: 
Option Compare Database
Private Sub Form_Timer()
      '==================================================================
      'The Timer event runs this code every minute. It compares your
      'system time with the StartTime variable. When they match, it
      'starts to compact all databases in the DBNames table.
      '==================================================================
 
      Dim StartTime As String
      ' Set this variable for the time you want compacting to start.
 
      StartTime = "02:58 PM"
      ' If StartTime is now, open the DBNames table and start compacting
 
      If Format(Now(), "medium time") = Format(StartTime, _
              "medium time") Then
         Dim RS As Recordset, DB As Database
         Dim NewDBName As String, DBName As String
         Set DB = CurrentDb()
         Set RS = DB.OpenRecordset("DBNames")
         On Error Resume Next
         RS.MoveFirst
         Do Until RS.EOF
            DBName = RS("DBFolder") & "\" & RS("DBName")
            ' Create a new name for the compacted database.
            ' This example uses the old name plus the current date.
            NewDBName = Left(DBName, Len(DBName) - 4)
            NewDBName = NewDBName & " " & Format(Date, "MMDDYY") & ".mdb"
            DBEngine.CompactDatabase DBName, NewDBName
         Loop
      ' Close the form, and then close Microsoft Access
      DoCmd.Close acForm, "CompactDB", acSaveYes
      RS.Close
      DoCmd.Quit acSaveYes
      End If
      End Sub

I added the cfso.Movefile ofcourse after i defined it. Check below code.

Code: 
      Dim StartTime As String
      ' Set this variable for the time you want compacting to start.
 
      Dim cFso
      Set cFso = CreateObject("Scripting.FileSystemObject")
      StartTime = "02:58 PM"
      ' If StartTime is now, open the DBNames table and start compacting
 
      If Format(Now(), "medium time") = Format(StartTime, _
              "medium time") Then
         Dim RS As Recordset, DB As Database
         Dim NewDBName As String, DBName As String
         Set DB = CurrentDb()
         Set RS = DB.OpenRecordset("DBNames")
         On Error Resume Next
         RS.MoveFirst
         Do Until RS.EOF
            DBName = RS("DBFolder") & "\" & RS("DBName")
            ' Create a new name for the compacted database.
            ' This example uses the old name plus the current date.
            NewDBName = Left(DBName, Len(DBName) - 4)
            NewDBName = NewDBName & " " & Format(Date, "MMDDYY") & ".mdb"
            DBEngine.CompactDatabase DBName, NewDBName
            cFso.Movefile "S:\Departments\Quality\QA Database\NewDBName", "S:\Departments\Quality\Databases Backup\NewDBName"
            RS.MoveNext
         Loop
      ' Close the form, and then close Microsoft Access
      DoCmd.Close acForm, "CompactDB", acSaveYes
      RS.Close
      DoCmd.Quit acSaveYes
      End If
      End Sub

Now the problem i am having and cant figure out a way around it is the compacted database is moved to the desired folder but it is not being named correctly. I always get NewDBName.

I have more than one database to compact so having an output of "NewDBName" is replacing the other databases.

But the vba logic is to take the current Database and add the date code to it compact it then move it and then go to the next database and so on so forth

Any help will be greatly appreciated, I just cant see what am I doing wrong
 
Try

cFso.Movefile "S:\Departments\Quality\QA Database\" & NewDBName, ...
 
Nope nothing happens, it compact&repair and rename it but never moves it.
Any other ideas or something else i need to try
 
Did you change it in both places?
 
Yes I did, and i tried it the other way by changing one place only and still same result
 
What exactly do you have now?
 
Below what i have right now

Code: 
Option Compare Database
Private Sub Form_Timer()
      '==================================================================
      'The Timer event runs this code every minute. It compares your
      'system time with the StartTime variable. When they match, it
      'starts to compact all databases in the DBNames table.
      '==================================================================
     
      Dim StartTime As String
      ' Set this variable for the time you want compacting to start.
      
      Dim cFso
      Set cFso = CreateObject("Scripting.FileSystemObject")
      StartTime = "03:50 PM"
      ' If StartTime is now, open the DBNames table and start compacting
      
      If Format(Now(), "medium time") = Format(StartTime, _
              "medium time") Then
         Dim RS As Recordset, DB As Database
         Dim NewDBName As String, DBName As String
         Set DB = CurrentDb()
         Set RS = DB.OpenRecordset("DBNames")
         On Error Resume Next
         RS.MoveFirst
         Do Until RS.EOF
            DBName = RS("DBFolder") & "\" & RS("DBName")
            ' Create a new name for the compacted database.
            ' This example uses the old name plus the current date.
            NewDBName = Left(DBName, Len(DBName) - 4)
            NewDBName = NewDBName & " " & Format(Date, "MMDDYY") & ".mdb"
            DBEngine.CompactDatabase DBName, NewDBName
'            DBEngine.CompactDatabase DBName, "S:\Departments\Quality\Databases Backup\BackupDB"
            cFso.Movefile "S:\Departments\Quality\QA Database\" & NewDBName, "S:\Departments\Quality\Databases Backup\" & NewDBName
            RS.MoveNext
         Loop
      ' Close the form, and then close Microsoft Access
      DoCmd.Close acForm, "CompactDB", acSaveYes
      RS.Close
      DoCmd.Quit acSaveYes
      End If
      End Sub
 
Another way to move files without using the FSO object:
Code: 
Dim strOldName As String
Dim strNewName As String

strOldName = "S:\Departments\Quality\QA Database\" & NewDBName
strNewName = "S:\Departments\Quality\Databases Backup\" & NewDBName

Name strOldName As strNewName
 
I just tested the fso part, and it worked as expected. Are you sure the path is right? I note you have 2 compacts now.
 
pbaldy said:
I just tested the fso part, and it worked as expected. Are you sure the path is right? I note you have 2 compacts now.
Click to expand...

Yes I have to compact, I was testing another approach, but the prior compact is commented...

So the fso worked with you, it saved it in the Backup folder and named it by adding the date to it. what did you change if i may ask
 
I tested with 2 paths on my PC and a variable for the file name. Try adding DoEvents between the compact and the move. Maybe the compact isn't done yet.
 
I will try it again at night and see why i cant get it to work while it worked with you.......
I want not only to save it into the backup folder i also want to add the date to the database too. So far i can get either or not both
 
boblarson said:
Another way to move files without using the FSO object:
Code: 
Dim strOldName As String
Dim strNewName As String
 
strOldName = "S:\Departments\Quality\QA Database\" & NewDBName
strNewName = "S:\Departments\Quality\Databases Backup\" & NewDBName
 
Name strOldName As strNewName
Click to expand...

I tried that approach and nothing moved....that is very Weird. I just cant find why I cant move the database when I use a variable name
 
pbaldy said:
I tested with 2 paths on my PC and a variable for the file name. Try adding DoEvents between the compact and the move. Maybe the compact isn't done yet.
Click to expand...

How did you get it to work, did you modify the code. I added "DoEvents" between the compact and the move as you suggested. The database was compacted and renamed but did not move.
I dont see the complication its straight forward atleast seems to me.
1. Rename database to be compacted
2. Compact
3. Move to Backup folder
 
My test was fairly simple, but I tried to duplicate your method:

Code: 
  Dim cFso
  Set cFso = CreateObject("Scripting.FileSystemObject")
  Dim x             As String
  x = "AccessTripDate.pdf"
  cFso.Movefile "C:\" & x, "C:\Documents and Settings\" & x
 
pbaldy said:
My test was fairly simple, but I tried to duplicate your method:

Code: 
  Dim cFso
  Set cFso = CreateObject("Scripting.FileSystemObject")
  Dim x             As String
  x = "AccessTripDate.pdf"
  cFso.Movefile "C:\" & x, "C:\Documents and Settings\" & x
Click to expand...

Try adding the below to your code and see if it works. I cant get it to work

Code: 
  Dim RS As Recordset, DB As Database
  Dim DBName As String
  Set DB = CurrentDb()
  Set RS = DB.OpenRecordset("DBNames")
DBName = RS("DBFolder") & "\" & RS("DBName") 
x = Left(DBName, Len(DBName) - 4)
x = NewDBName & " " & Format(Date, "MMDDYY") & ".mdb"
 
I don't have a table with names and paths, as that seems to require. Rather than me trying to recreate what you've got, why don't you post a sample db?
 
attached is the db that i am trying to use to
1. Rename db's by adding date.
2. Compact Newdb
3. Move to Newdb to Backupfolder
 

Attachments

You must log in or register to reply here.

Similar threads

T
Problem with NAME Statement
Replies
2
Views
337
Mark_
M
N
Solved Failing To Save Imported Data from the internet in Ms Access
Replies
6
Views
599
nector
N
klsblues
VBA Conditional Formatting error because I have more than 3 formatting requirements.
2 3
Replies
53
Views
2,199
AHeyne
A
A
Solved VBA code for deleting Outlook 'Appointments' lying within a specified date range
Replies
8
Views
615
Gasman
Gasman
A
Solved Consolidate Employee Time In/Out take time to load.
Replies
3
Views
498
atzdgreat
A

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom