Форум программистов, компьютерный форум, киберфорум
Microsoft Access
Форум программистов и сисадминов Киберфорум > Форум программистов > Базы данных > Microsoft Access
Войти
Регистрация
Восстановить пароль
Карта форума Темы раздела Блоги Сообщество Поиск Заказать работу  
 
Рейтинг 4.72/18: Рейтинг темы: голосов - 18, средняя оценка - 4.72
0 / 0 / 0
Регистрация: 10.04.2015
Сообщений: 9
1

Обработка ошибок в Access

11.02.2016, 13:11. Показов 3725. Ответов 4
Метки нет (Все метки)
Author24 — интернет-сервис помощи студентам
Добрый день. Подготовил код для вставки данных из Excel в Access.
В процессе импорта возникает ошибка на строке 66 если строка с ключевым полем уже имеется в таблицах.
Ошибка: Приложению не удалось выполнить добавление в таблицу всех данных ( нарушение уникальности ключей).
Обработка ошибок в Access

Необходимо чтобы обработчик ошибок после такой ситуации сразу переходил к выполнению следующего файла n=n+1 а не продолжал код со строки 70 если нажать "Да" в диалоговом окне.
Диалоговое окно тоже не надо показывать в идеале.
Помогите пожалуйста с написанием

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103

Sub ImportExcel2()
Dim strExcelPath As String, strTableName As String, strRangeName As String, strFile As String, IMPORT_FOLDER As String, n As Integer, strPathFile As String
Dim IMPORT_FOLDER_DONE As String, strExcelPathDone As String, strPathFileDone As String, strFileNew As String
IMPORT_FOLDER = "import"
IMPORT_FOLDER_DONE = "import\импоритрованные"
    If Dir(CurrentProject.Path & "" & IMPORT_FOLDER, vbDirectory) = "" Then
    MkDir CurrentProject.Path & "" & IMPORT_FOLDER
    End If
    
        If Dir(CurrentProject.Path & "" & IMPORT_FOLDER_DONE, vbDirectory) = "" Then
    MkDir CurrentProject.Path & "" & IMPORT_FOLDER_DONE
    End If
strExcelPath = CurrentProject.Path & "" & IMPORT_FOLDER
strExcelPathDone = CurrentProject.Path & "" & IMPORT_FOLDER_DONE
strTableName = "акты_импортированные_2"
strRangeName = "Лист1!B4:D7"
strFile = Dir(strExcelPath & "*.xlsm")
n = 0
If strFile = Empty Then
    MsgBox "В папке:" & vbCr & strExcelPath & vbCr & "нет файлов для импорта"
    Else: Do While Len(strFile) > 0
 
                strPathFile = strExcelPath & strFile
                strFileNew = "Импоритрован_" & strFile
                strPathFileDone = strExcelPathDone & strFileNew
                Call DoCmd.TransferSpreadsheet(acImport, _
                acSpreadsheetTypeExcel12, strTableName, strPathFile, _
                True, strRangeName)
                Name strPathFile As strPathFileDone
                'Kill strPathFile
                strFile = Dir()
                n = n + 1
    Loop
    MsgBox "Импортирован(о) " & n & " файл(ов)"
    End If
 
End Sub
Sub ImportExcel3()
Dim strExcelPath As String, strTableName As String, strRangeName As String, strFile As String, IMPORT_FOLDER As String, n As Integer, strPathFile As String
Dim IMPORT_FOLDER_DONE As String, strExcelPathDone As String, strPathFileDone As String, strFileNew As String
IMPORT_FOLDER = "import"
IMPORT_FOLDER_DONE = "import\импоритрованные"
    If Dir(CurrentProject.Path & "" & IMPORT_FOLDER, vbDirectory) = "" Then
    MkDir CurrentProject.Path & "" & IMPORT_FOLDER
    End If
    
        If Dir(CurrentProject.Path & "" & IMPORT_FOLDER_DONE, vbDirectory) = "" Then
    MkDir CurrentProject.Path & "" & IMPORT_FOLDER_DONE
    End If
strExcelPath = CurrentProject.Path & "" & IMPORT_FOLDER
strExcelPathDone = CurrentProject.Path & "" & IMPORT_FOLDER_DONE
 
strFile = Dir(strExcelPath & "*.xlsm")
n = 0
 
If strFile = Empty Then
    MsgBox "В папке:" & vbCr & strExcelPath & vbCr & "нет файлов для импорта"
    Else: Do While Len(strFile) > 0
    
                          
                strPathFile = strExcelPath & strFile
                strFileNew = "Импоритрован_" & strFile
                strPathFileDone = strExcelPathDone & strFileNew
                strTableName = "rekvizity"
                strRangeName = "rekvizity"
                Call DoCmd.TransferSpreadsheet(acImport, _
                acSpreadsheetTypeExcel12, strTableName, strPathFile, _
                True, strRangeName)
                
                strTableName = "obekty"
                strRangeName = "obekty"
                Call DoCmd.TransferSpreadsheet(acImport, _
                acSpreadsheetTypeExcel12, strTableName, strPathFile, _
                True, strRangeName)
                
                strTableName = "napravleniy"
                strRangeName = "napravleniy"
                Call DoCmd.TransferSpreadsheet(acImport, _
                acSpreadsheetTypeExcel12, strTableName, strPathFile, _
                True, strRangeName)
                
                strTableName = "meropriytiy"
                strRangeName = "meropriytiy"
                Call DoCmd.TransferSpreadsheet(acImport, _
                acSpreadsheetTypeExcel12, strTableName, strPathFile, _
                True, strRangeName)
                
                strTableName = "narusheniy"
                strRangeName = "narusheniy"
                Call DoCmd.TransferSpreadsheet(acImport, _
                acSpreadsheetTypeExcel12, strTableName, strPathFile, _
                True, strRangeName)
                
                Name strPathFile As strPathFileDone
                'Kill strPathFile
                strFile = Dir()
                n = n + 1
             
    Loop
    MsgBox "Импортирован(о) " & n & " файл(ов)"
    End If
        
End Sub
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
 11.02.2016, 13:11
Ответы с готовыми решениями:

Обработка ошибок
Не подскажите, где можно найти материал на эту тему..

Обработка ошибок в приложении вцелом
Есть ли возможность отловить событие возникновения ошибки на уровне приложения, без обработки в...

Обработка ошибок в go
Добрый день. Начал изучать go и первое что бросилось в глаза такие конструкции во всех примерах ...

Обработка ошибок в VB
Доброго времени суток, Уважаемые! Решил добавить в программу обработку ошибок, но работает это...

4
Эксперт MS Access
26815 / 14494 / 3192
Регистрация: 28.04.2012
Сообщений: 15,782
11.02.2016, 13:34 2
В данном случае, когда место и тип ошибки точно определены, имеет смысл использовать обработку по Resume Next
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14

                On Error Resume Next
                Call DoCmd.TransferSpreadsheet(acImport, _
                acSpreadsheetTypeExcel12, strTableName, strPathFile, _
                True, strRangeName)
                If err<>0 Then 
                    err.Clear 
                    On Error Goto 0    'На случай других ошибок: не обходить их, а увидеть сообщение 
                    Goto nextfile      'Уходим на метку nextfile
                End If
...........................................
...........................................
nextfile:
                n=n+1
            Loop
0
0 / 0 / 0
Регистрация: 10.04.2015
Сообщений: 9
11.02.2016, 15:39  [ТС] 3
Все логично, но диалоговое окно появляется и нижестоящий код выполняется после нажатия "Да"
Тут ошибка идет не из VBA а из Accesa в этом то может и причина. Код может выполнятся но не дает сам Access выполнить процедуру.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76

Sub ImportExcel3()
Dim strExcelPath As String, strTableName As String, strRangeName As String, strFile As String, IMPORT_FOLDER As String, n As Integer, strPathFile As String
Dim IMPORT_FOLDER_DONE As String, strExcelPathDone As String, strPathFileDone As String, strFileNew As String
IMPORT_FOLDER = "import"
IMPORT_FOLDER_DONE = "import\импоритрованные"
    If Dir(CurrentProject.Path & "" & IMPORT_FOLDER, vbDirectory) = "" Then
    MkDir CurrentProject.Path & "" & IMPORT_FOLDER
    End If
    
        If Dir(CurrentProject.Path & "" & IMPORT_FOLDER_DONE, vbDirectory) = "" Then
    MkDir CurrentProject.Path & "" & IMPORT_FOLDER_DONE
    End If
strExcelPath = CurrentProject.Path & "" & IMPORT_FOLDER
strExcelPathDone = CurrentProject.Path & "" & IMPORT_FOLDER_DONE
 
strFile = Dir(strExcelPath & "*.xlsm")
n = 0
 
If strFile = Empty Then
    MsgBox "В папке:" & vbCr & strExcelPath & vbCr & "нет файлов для импорта"
    Else: Do While Len(strFile) > 0
    
                          
                strPathFile = strExcelPath & strFile
                strFileNew = "Импоритрован_" & strFile
                strPathFileDone = strExcelPathDone & strFileNew
                strTableName = "rekvizity"
                strRangeName = "rekvizity"
                
                On Error Resume Next
                Call DoCmd.TransferSpreadsheet(acImport, _
                acSpreadsheetTypeExcel12, strTableName, strPathFile, _
                True, strRangeName)
                
                If Err <> 0 Then
                    Err.Clear
                    On Error GoTo 0    'На случай других ошибок: не обходить их, а увидеть сообщение
                    GoTo nextfile      'Уходим на метку nextfile
                End If
 
                strTableName = "obekty"
                strRangeName = "obekty"
                Call DoCmd.TransferSpreadsheet(acImport, _
                acSpreadsheetTypeExcel12, strTableName, strPathFile, _
                True, strRangeName)
                
                strTableName = "napravleniy"
                strRangeName = "napravleniy"
                Call DoCmd.TransferSpreadsheet(acImport, _
                acSpreadsheetTypeExcel12, strTableName, strPathFile, _
                True, strRangeName)
                
                strTableName = "meropriytiy"
                strRangeName = "meropriytiy"
                Call DoCmd.TransferSpreadsheet(acImport, _
                acSpreadsheetTypeExcel12, strTableName, strPathFile, _
                True, strRangeName)
                
                strTableName = "narusheniy"
                strRangeName = "narusheniy"
                Call DoCmd.TransferSpreadsheet(acImport, _
                acSpreadsheetTypeExcel12, strTableName, strPathFile, _
                True, strRangeName)
                
                Name strPathFile As strPathFileDone
                'Kill strPathFile
                strFile = Dir()
             
nextfile:
                n = n + 1
        
    Loop
    MsgBox "Импортирован(о) " & n & " файл(ов)"
    End If
        
End Sub
Добавлено через 1 час 54 минуты
Прикладываю файл.
https://yadi.sk/d/wTKEQCdoofToH
0
-22 / 1 / 0
Регистрация: 04.03.2017
Сообщений: 234
30.04.2020, 15:07 4
mobile, Привет!
А если ошибка в коде при выполнении?

Visual Basic
1
2
3
4

Private Sub Кнопка41_Click()
Me.КлючПовтор.SetFocus
DoCmd.RunCommand acCmdPaste
End Sub
Например нет в буфере обмена ни чего для вставки, он выдает ошибку.
Можно ли какое-то условие поставить, чтобы выводилось сообщение, что буфер обмена пуст и команда не может быть выполнена?

Спасибо заранее за ответ.
0
10741 / 5582 / 1409
Регистрация: 05.10.2016
Сообщений: 15,787
30.04.2020, 15:33 5
Цитата Сообщение от BaumEV Посмотреть сообщение
Можно ли какое-то условие поставить, чтобы выводилось сообщение, что буфер обмена пуст и команда не может быть выполнена?
Можно!
Попробуйте так:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

Private Sub Кнопка41_Click()
 
On Error GoTo Кнопка41_Click_Err
    Me!КлючПовтор.SetFocus
    DoCmd.RunCommand acCmdPaste
    
Кнопка41_Click_End:
    Exit Sub
 
Кнопка41_Click_Err:
    
    Select Case Err.Number 'обработка ошибок по номеру
        Case 2046 'Команда не доступна! (нет в буфере обмена ничего для вставки)
            MsgBox "Команда не домступна! (нет в буфере обмена ничего для вставки)", vbExclamation
        Case Else
            MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Sub Кнопка41_Click.", _
                vbCritical, "Произошла ошибка!"
    End Select
    Err.Clear
    Resume Кнопка41_Click_End
 
End Sub
0
30.04.2020, 15:33
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
 30.04.2020, 15:33
Помогаю со студенческими работами здесь

Обработка ошибок
Можно в одной процедуре использовать 2 раза On Error GoToсоответственно для одной части кода и для...

Обработка ошибок
Здравствуйте! У меня такой вопрос. Как отменить выполнение программного кода, при возникновении...

Обработка ошибок
Доброго времени суток ! Суть проста: нажимаю на менюшку, она должна загрузить изображение на...

Обработка ошибок
Подскажите как выводить ошибки в какой либо форме при неверном заполнении полей!Нужно чтобы ошибка...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
5
Ответ Создать тему
КиберФорум - форум программистов, компьютерный форум, программирование
Поддержать - Реклама - Обратная связь
Powered by vBulletin
Copyright ©2000 - 2024, CyberForum.ru