Добрый день!
Есть код в Access, который открывает Excell-файл и загружает из него строки в свою таблицу.
Перед загрузкой стоит строка проверки количества строк в Excel:
1.
lLastRow = Cells.SpecialCells(xlLastCell).Row
Если код запустить первый раз, то он отрабатывает успешно. При этом, в процессах Windows появляется новый процесс: EXCEL.EXE. Почему-то после завершения процедуры этот процесс не закрывается (хотя есть xlt.Close (False)).
Если сразу снова запустить эту же процедуру, то возникает ошибка: <
Method 'Cells' of object '_Global' failed > на строке:
1.
lLastRow = Cells.SpecialCells(xlLastCell).Row
При этом, естественно, в процессах появился второй EXCEL.EXE, который не закрылся из-за ошибки.
Но если не удалять эти два процесса EXCEL.EXE, а перезапустить клиента Access и затем процедуру, то всё работает корректно, процедуру можно запускать несколько раз подряд, при этом, после её отработки второй процесс EXCEL.EXE успешно открывается и закрывается, а первый просто висит...
Если НЕ перезапускать клиента Access, а в диспетчере завершить все процессы EXCEL.EXE и запустить процедуру, то появится другая ошибка: <
The remote server machine does not exist or is unavaliable >.
И наконец, если перезапустить клиента и удалить ВСЕ процессы EXCEL.EXE, то опять первый раз отработает корректно...
Просьба помочь разобраться, в чём суть ошибки, почему при (с виду) одних и тех же условиях, код то работает, то нет. Может я неправильно закрываю Excel?
Заранее благодарен!
Вот сама процедура целиком:
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.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
Private Sub РисунокЗагрузитьФайл_Click()
Dim Sht As String
Dim ln As String
Dim sg As String
Dim tm24 As String
Dim tm48 As String
Dim Line As String
Dim m_str() As String
Dim Shd_sur As String
Dim Shd_fir As String
Dim Shd_par As String
Dim time24 As Date
Dim time48 As Date
'###############################################
DoCmd.SetWarnings False
DoCmd.RunSQL "delete from свод" ' удалили всё из таблицы "свод"
DoCmd.SetWarnings True
'#############################################
DoCmd.SetWarnings False
Dim file As String
' проверяем, есть ли файл в директории:
Dim path, nameFile
path = "\\tb-fs05\Department-2\SSI\Àíäðåé\ÓÐÂÊÊ\Âûãðóçêà_CRM"
nameFile = "Создать_документ.xlsx"
If Dir(path & "\" & nameFile) = "" Then ' если файла нет, выводим сообщение и выходим из процедуры:
MsgBox "В папке " & path & " нет файла " & filename"
Exit Sub
Else
file = "\\tb-fs05\Department-2\SSI\УРВКК\Выгрузка\Создать_документ.xlsx"
Set xl = CreateObject("Excel.Application")
Set xlt = xl.Workbooks.Open(file)
Dim llastrow As Long
Dim k As Long
llastrow = Cells.SpecialCells(xlLastCell).row ' нашли количество заполненных строк в Excel
For k = 1 To llastrow
Shd = xlt.ActiveSheet.Cells(k + 1, 9).Value ' ФИО
Sht = xlt.ActiveSheet.Cells(k + 1, 10).Value ' дата регистрации
DrN = xlt.ActiveSheet.Cells(k + 1, 14).Value 'номер
Car = xlt.ActiveSheet.Cells(k + 1, 18).Value 'этап
sg = xlt.ActiveSheet.Cells(k + 1, 3).Value 'группа
'удаляем апостроф, если он найден в ФИО
Shd = Replace(Shd, "'", "")
'=================================================================
' расчёт количества слов в ячейке:
Dim iStr As String 'исходная строка
Dim b As String 'строка без пробелов
Dim x As String 'текущий символ в строке
Dim i As Integer 'номер текущего символа
Dim j As Integer 'счётчик пробелов
Dim y As Integer 'количество слов
iStr = Shd
b = Trim(iStr)
j = 0
For i = 1 To Len(b)
x = Mid(b, i, 1)
If x = " " Then j = j + 1
Next i
y = j + 1 ' записали количество слов в переменную
'====================================================================
m_str() = Split(Shd, " ")
If Shd <> "" Then 'ïпроверяем ячейку с ФИО на значение NULL
If y = 3 Then 'если полное ФИО
Shd_sur = m_str(0) ' выделили фамилию
Shd_fir = m_str(1) ' имя
Shd_par = m_str(2) ' отчество
Set rstLine = Nothing
' в таблице users нашли данного сотрудника:
Sqltext = "Select users.surname, users.first_name, users.patronymic, users.line_id" _
& " FROM users WHERE (CAST(surname as varchar) = '" & Shd_sur & "') And (CAST(first_name as varchar) = '" & Shd_fir & "') And (CAST (patronymic as varchar) = '" & Shd_par & "');"
rstLine.Open Sqltext, cn, adOpenKeyset, adLockOptimistic
ElseIf y = 2 Then ' если нет отчества:
Shd_sur = m_str(0) ' фамилия
Shd_fir = m_str(1) ' имя
Shd_par = "" ' пусто
Set rstLine = Nothing
Sqltext = "Select users.surname, users.first_name, users.patronymic, users.line_id" _
& " FROM users WHERE (CAST(surname as varchar) = '" & Shd_sur & "') And (CAST(first_name as varchar) = '" & Shd_fir & "');"
rstLine.Open Sqltext, cn, adOpenKeyset, adLockOptimistic
End If
End If
If rstLine.RecordCount > 0 Then проверяем, найден ли сотрудник в таблице users
If (rstLine.Fields(3) = 26) Or (rstLine.Fields(3) = 27) Then ' проверяем доп. условия
If (sg = "Жалобы") Or (sg = "Претензии") Then
If Shd Like FIO Then
' ###################### далее расчёт временных интервалов ################################
Sht = DateAdd("h", 7, CDate(Sht))
Sht = DateAdd("h", -24, CDate(Sht)) ' ñíà÷àëà îòíèìàåì 24 ÷àñà, ÷òîáû â öèêëå ïðèáàâèòü è ñíîâà âûéòè íà âðåìÿ ðåãèñòðàöèè
Do
Sht = DateAdd("h", 24, CDate(Sht))
Set rstTimeReg = Nothing
Sqltext = "Select id, ddmmyy, output, holiday FROM Calendar WHERE ddmmyy = '" & (Format(Sht, "yyyy-mm-dd")) & "';"
rstTimeReg.Open Sqltext, cn, adOpenKeyset, adLockOptimistic
Loop While ((rstTimeReg.Fields(2) = 1) Or (rstTimeReg.Fields(3) = 1))
tm24 = Sht
Do
tm24 = DateAdd("h", 24, CDate(tm24))
Set rstTime24 = Nothing
Sqltext = "Select id, ddmmyy, output, holiday FROM Calendar WHERE ddmmyy = '" & (Format(tm24, "yyyy-mm-dd")) & "';"
rstTime24.Open Sqltext, cn, adOpenKeyset, adLockOptimistic
Loop While ((rstTime24.Fields(2) = 1) Or (rstTime24.Fields(3) = 1))
tm48 = tm24
Do
tm48 = DateAdd("h", 24, CDate(tm48))
Set rstTime48 = Nothing
Sqltext = "Select id, ddmmyy, output, holiday FROM Calendar WHERE ddmmyy = '" & (Format(tm48, "yyyy-mm-dd")) & "';"
rstTime48.Open Sqltext, cn, adOpenKeyset, adLockOptimistic
Loop While ((rstTime48.Fields(2) = 1) Or (rstTime48.Fields(3) = 1))
'#################################################################################
' если все проверки прошли и интервалы вычислили, добавляем строку в таблицу access:
DoCmd.RunSQL "INSERT INTO свод(ФИО,Дата, Номер, Этап, остаток_24, остаток_48) select '" & Shd & "','" & Sht & "','" & DrN & "','" & Car & "', '" & tm24 & "', '" & tm48 & "'"
End If
End If
End If
End If
Next k ' перешли к следующей записи
xlt.Close (False) ' закрыли Excel
End If
DoCmd.SetWarnings True
' обновляем поля формы:
Sqltext = "SELECT Код, ФИО, Дата, Номер, Этап, остаток_24, остаток_48" _
& " FROM свод order by CDate(остаток_48) DESC"
Set rstaccess_local = Nothing
rstaccess_local.Open Sqltext, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
Set Me.Form.Recordset = rstaccess_local
End Sub
