Для Ac97 пытаюсь программно сжать базу данных, таким образом:
With CommandBars.Add(, 1, , True)
.Controls.Add 1, 2071, , , True
.Visible = True
.Controls(1).SetFocus
DoEvents
SendKeys "~"
End With
(Взято из Faq)

Я вставляю это в обработчик нажатия на кнопку, которая делает бэкапирование Б.Д. (из Гетца "Сборник рецептов"), то есть перед бэкапом надо сжать БД. При нажатии на кнопку появляется на панели инструментов пустой квадратик, нажав на который происходит сжатие, но если на него не нажимать, то ничего не происходит. Думаю что дело в DoEvents.
Вот обработчик нажатия на кнпоку "Бэкап":

Private Sub cmdBackup_Click()

Call MakeBackup(Me!txtOutputDatabase)

End Sub

Sub MakeBackup(ByVal strOutputDatabase As String)

Dim dbOutput As Database
Dim intType As Integer
Dim ctlObjects As ListBox
Dim varItem As Variant
Dim strType As String
Dim strName As String
Dim intObjTot As Integer
Dim intObjCnt As Integer
Dim ctlProgress As TextBox

On Error GoTo HandleErr

Set ctlProgress = Me!txtProgress
Set ctlObjects = Me!lboObjects

ctlProgress.Visible = True
ctlProgress = "Initializing..."

intObjTot = ctlObjects.ItemsSelected.Count

If Len(Dir(strOutputDatabase)) > 0 Then
DoCmd.Hourglass False
Beep
If MsgBox("Output Database exists. Overwrite?", _
vbYesNo + vbQuestion) = vbYes Then
Kill strOutputDatabase
Else
Exit Sub
End If
End If

ctlProgress = "Creating " & strOutputDatabase & "..."
DoEvents

Set dbOutput = DBEngine.Workspaces(0). _
CreateDatabase(strOutputDatabase, dbLangGeneral)

dbOutput.Close

intObjCnt = 0
ctlProgress = "Backing up objects..."

Dim iii As Integer
For iii = 1 To ctlObjects.ListCount - 1
intObjCnt = intObjCnt + 1
strType = ctlObjects.Column(0, iii)
strName = ctlObjects.Column(1, iii)
ctlProgress = "Backing up " & strName & "..."
DoEvents
Call ExportObject(strOutputDatabase, strType, strName)
Next
Debug.Print "lala:" & ctlObjects.Column(0, 0)
Debug.Print "lalala:" & ctlObjects.Column(1, 0)
Debug.Print "lala:" & ctlObjects.Column(0, ctlObjects.ListCount - 1)
Debug.Print "lalala:" & ctlObjects.Column(1, ctlObjects.ListCount - 1)

ctlProgress = "Backup finished!"

ExitHere:
Exit Sub

HandleErr:
Select Case err
Case Else
MsgBox err & ": " & err.Description, , _
"MakeBackup"
End Select
Resume ExitHere
End Sub

Подскажите, пожалуйста, что я делаю не так?