Private Sub Кнопка6_Click()
On Error GoTo ФайлЗанят_Err
'необходимо подключение библиотеки Microsoft Scripting Runtime
Dim fs As New FileSystemObject
'если файл существует то удаляем файл если файл занят приложением то возникнет ошибка
'которую чуть ниже отловим
If fs.FileExists("c:\1.xls") = True Then fs.DeleteFile ("c:\1.xls")
DoCmd.OutputTo acQuery, "Запрос1", "MicrosoftExcelBiff8(*.xls)", "c:\1.xls", True, "", 0
Set fs = Nothing
ФайлЗанят_Exit:
Exit Sub
ФайлЗанят_Err:
If Err = 70 Then
MsgBox "В настоящее время выгрузка невозможна - повторите попытку чуть позже"
Else
MsgBox Error$
End If
Resume ФайлЗанят_Exit
End Sub
|