Добрый день!
Есть код в Access, который открывает Excell-файл и загружает из него строки в свою таблицу.
Перед загрузкой стоит строка проверки количества строк в Excel:
lLastRow = Cells.SpecialCells(xlLastCell).Row
Если код запустить первый раз, то он отрабатывает успешно. При этом, в процессах Windows появляется новый процесс: EXCEL.EXE. Почему-то после завершения процедуры этот процесс не закрывается (хотя есть xlt.Close (False)).
Если сразу снова запустить эту же процедуру, то возникает ошибка: <
Method 'Cells' of object '_Global' failed> на строке:
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?
Заранее благодарен!
Вот сама процедура целиком:
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
http://www.sql.ru/forum/1270950/oshibka-method-cells-of-object-global-failed-pri-proverke-kolichestva-strok
