| | На моем компе (win 7 ultimat) все работает нормально. на компьютере пользователя при работе процедуры переодически окно ввда пароля Подключения к SQL серверу, причем пароль проходит только со 2-го раза.
На всякий случай вот код процедуры
Private Sub knGo_Click()
DoCmd.Hourglass True
Dim db As DAO.Database
Dim rstEx As DAO.Recordset
Dim rst As DAO.Recordset
On Error Resume Next
' Dim lstExl As Object
Set db = CurrentDb
If ExcelOpen(Me!pFile.Value) = 1 And Len(Me!pFile.Value) > 0 Then
Set rstEx = db.OpenRecordset("tblExcel")
tTime = Now
Do While Not rstEx.EOF
For Each wsh In ExcelApp.Worksheets
If wsh.Name = rstEx!excelshet Then Exit For
Next wsh
'Бар
If Len(wsh.Cells(2, Day(Me!pDat) + 1).Value) = 0 Then
SysCmd acSysCmdSetStatus, DLookup("[dvsn_name]", "dbo_divisions", "dvsn_id = " & rstEx!Division) & " - Бар"
Set rst = db.OpenRecordset("SELECT Sum([orit_count]*[orit_price]) AS SM " & _
"FROM (dbo_Archives INNER JOIN (dbo_OrderItems INNER JOIN (dbo_Orders INNER JOIN dbo_Guests ON dbo_Orders.ordr_gest_ID = dbo_Guests.gest_ID) ON dbo_OrderItems.orit_ordr_ID = dbo_Orders.ordr_ID) ON dbo_Archives.arch_ID = dbo_Guests.gest_arch_ID) INNER JOIN (dbo_MenuItemsVer INNER JOIN dbo_MenuGroupsVer ON dbo_MenuItemsVer.mitv_mgrp_ID = dbo_MenuGroupsVer.mgrv_mgrp_ID) ON dbo_OrderItems.orit_mitm_ID = dbo_MenuItemsVer.mitv_mitm_ID " & _
"WHERE (((GRUP([mgrv_mgrp_ID]))='Бар') AND ((dbo_OrderItems.orit_deld_ID) Is Null) AND ((dbo_MenuItemsVer.mitv_mver_ID) Is Null) AND ((dbo_MenuGroupsVer.mgrv_mver_ID) Is Null) AND ((dbo_Archives.arch_dvsn_ID)=" & rstEx!Division & ") AND (dbo_Archives.arch_DateOpen>=#" & Format(Me!pDat, "mm\/dd\/yyyy") & "# And dbo_Archives.arch_DateOpen<#" & Format(DateAdd("d", 1, Me!pDat), "mm\/dd\/yyyy") & "#))")
wsh.Cells(2, Day(Me!pDat) + 1).Value = rst!sm
End If
'кухня
If Len(wsh.Cells(3, Day(Me!pDat) + 1).Value) = 0 Then
SysCmd acSysCmdSetStatus, DLookup("[dvsn_name]", "dbo_divisions", "dvsn_id = " & rstEx!Division) & " - Кухня"
Set rst = db.OpenRecordset("SELECT Sum([orit_count]*[orit_price]) AS SM " & _
"FROM (dbo_Archives INNER JOIN (dbo_OrderItems INNER JOIN (dbo_Orders INNER JOIN dbo_Guests ON dbo_Orders.ordr_gest_ID = dbo_Guests.gest_ID) ON dbo_OrderItems.orit_ordr_ID = dbo_Orders.ordr_ID) ON dbo_Archives.arch_ID = dbo_Guests.gest_arch_ID) INNER JOIN (dbo_MenuItemsVer INNER JOIN dbo_MenuGroupsVer ON dbo_MenuItemsVer.mitv_mgrp_ID = dbo_MenuGroupsVer.mgrv_mgrp_ID) ON dbo_OrderItems.orit_mitm_ID = dbo_MenuItemsVer.mitv_mitm_ID " & _
"WHERE (((GRUP([mgrv_mgrp_ID]))='Кухня') AND ((dbo_OrderItems.orit_deld_ID) Is Null) AND ((dbo_MenuItemsVer.mitv_mver_ID) Is Null) AND ((dbo_MenuGroupsVer.mgrv_mver_ID) Is Null) AND ((dbo_Archives.arch_dvsn_ID)=" & rstEx!Division & ") AND (dbo_Archives.arch_DateOpen>=#" & Format(Me!pDat, "mm\/dd\/yyyy") & "# And dbo_Archives.arch_DateOpen<#" & Format(DateAdd("d", 1, Me!pDat), "mm\/dd\/yyyy") & "#))")
wsh.Cells(3, Day(Me!pDat) + 1).Value = rst!sm
End If
'Кухня персонал
If Len(wsh.Cells(11, Day(Me!pDat) + 1).Value) = 0 Then
SysCmd acSysCmdSetStatus, DLookup("[dvsn_name]", "dbo_divisions", "dvsn_id = " & rstEx!Division) & " - Кухня персонал"
Set rst = db.OpenRecordset("SELECT Sum([orit_count]*[orit_price]) AS SM " & _
"FROM (dbo_Archives INNER JOIN (dbo_OrderItems INNER JOIN (dbo_Orders INNER JOIN dbo_Guests ON dbo_Orders.ordr_gest_ID = dbo_Guests.gest_ID) ON dbo_OrderItems.orit_ordr_ID = dbo_Orders.ordr_ID) ON dbo_Archives.arch_ID = dbo_Guests.gest_arch_ID) INNER JOIN (dbo_MenuItemsVer INNER JOIN dbo_MenuGroupsVer ON dbo_MenuItemsVer.mitv_mgrp_ID = dbo_MenuGroupsVer.mgrv_mgrp_ID) ON dbo_OrderItems.orit_mitm_ID = dbo_MenuItemsVer.mitv_mitm_ID " & _
"WHERE (((GRUP([mgrv_mgrp_ID]))='Кухня персонал') AND ((dbo_OrderItems.orit_deld_ID) Is Null) AND ((dbo_MenuItemsVer.mitv_mver_ID) Is Null) AND ((dbo_MenuGroupsVer.mgrv_mver_ID) Is Null) AND ((dbo_Archives.arch_dvsn_ID)=" & rstEx!Division & ") AND (dbo_Archives.arch_DateOpen>=#" & Format(Me!pDat, "mm\/dd\/yyyy") & "# And dbo_Archives.arch_DateOpen<#" & Format(DateAdd("d", 1, Me!pDat), "mm\/dd\/yyyy") & "#))")
wsh.Cells(11, Day(Me!pDat) + 1).Value = rst!sm
End If
'Административные
If Len(wsh.Cells(6, Day(Me!pDat) + 1).Value) = 0 Then
SysCmd acSysCmdSetStatus, DLookup("[dvsn_name]", "dbo_divisions", "dvsn_id = " & rstEx!Division) & " - Административные"
Set rst = db.OpenRecordset("SELECT Sum([orit_count]*[orit_price]) AS SM " & _
"FROM (dbo_Archives INNER JOIN (dbo_OrderItems INNER JOIN (dbo_Orders INNER JOIN dbo_Guests ON dbo_Orders.ordr_gest_ID = dbo_Guests.gest_ID) ON dbo_OrderItems.orit_ordr_ID = dbo_Orders.ordr_ID) ON dbo_Archives.arch_ID = dbo_Guests.gest_arch_ID) INNER JOIN (dbo_MenuItemsVer INNER JOIN dbo_MenuGroupsVer ON dbo_MenuItemsVer.mitv_mgrp_ID = dbo_MenuGroupsVer.mgrv_mgrp_ID) ON dbo_OrderItems.orit_mitm_ID = dbo_MenuItemsVer.mitv_mitm_ID " & _
"WHERE (((GRUP([mgrv_mgrp_ID]))='Административные') AND ((dbo_OrderItems.orit_deld_ID) Is Null) AND ((dbo_MenuItemsVer.mitv_mver_ID) Is Null) AND ((dbo_MenuGroupsVer.mgrv_mver_ID) Is Null) AND ((dbo_Archives.arch_dvsn_ID)=" & rstEx!Division & ") AND (dbo_Archives.arch_DateOpen>=#" & Format(Me!pDat, "mm\/dd\/yyyy") & "# And dbo_Archives.arch_DateOpen<#" & Format(DateAdd("d", 1, Me!pDat), "mm\/dd\/yyyy") & "#))")
wsh.Cells(6, Day(Me!pDat) + 1).Value = rst!sm
End If
'Количество гостей
If Len(wsh.Cells(15, Day(Me!pDat) + 1).Value) = 0 Then
SysCmd acSysCmdSetStatus, DLookup("[dvsn_name]", "dbo_divisions", "dvsn_id = " & rstEx!Division) & " - Количество гостей"
Set rst = db.OpenRecordset("SELECT Sum(dbo_Guests.gest_Count) AS [sm] " & _
"FROM (dbo_Archives INNER JOIN dbo_Guests ON dbo_Archives.arch_ID = dbo_Guests.gest_arch_ID) LEFT JOIN dbo_BalanceUsers ON dbo_Guests.gest_busr_ID = dbo_BalanceUsers.busr_ID " & _
"WHERE (((dbo_Archives.arch_DateOpen)>=#" & Format(Me!pDat, "mm\/dd\/yyyy") & "# And (dbo_Archives.arch_DateOpen)<#" & Format(DateAdd("d", 1, Me!pDat), "mm\/dd\/yyyy") & "#) AND ((dbo_Archives.arch_dvsn_ID)=" & rstEx!Division & ") AND ((dbo_BalanceUsers.busr_Name) Is Null Or ((dbo_BalanceUsers.busr_Name) Not Like ('обед*') And ((dbo_BalanceUsers.busr_Name) Not Like ('штраф*')))))")
wsh.Cells(15, Day(Me!pDat) + 1).Value = rst!sm
End If
rstEx.MoveNext
Loop
Else
MsgBox "Ошибка открытия файла"
End If
DoCmd.Hourglass False
vp = ExcelSave
vp = ExcelQuit()
vp = ExcelOpen(Me!pFile.Value, True)
MsgBox "Время обработки: " & CDate(Now - tTime)
End Sub
|
функция grup
Public Function GRUP(mgrv_mgrp_ID) As String
Dim rst As Recordset
id = mgrv_mgrp_ID
Do While Not IsNull(id)
Set rst = CurrentDb.OpenRecordset("select * from dbo_MenuGroupsVer where isnull(mgrv_mver_id) and mgrv_mgrp_ID=" & id, dbOpenDynaset, dbSeeChanges)
If rst.EOF Then
id = Null
Else
rst.MoveFirst
id = rst!mgrv_mgrp_ID_Parent
vStr = rst!mgrv_Name
End If
Loop
rst.Close
lngStr = InStr(1, vStr, " ")
If lngStr = 0 Then
vStr = "НЕТ"
Else
If Left(vStr, 14) = "Кухня персонал" Then
vStr = "Кухня персонал"
Else
vStr = Left(vStr, lngStr - 1)
End If
End If
GRUP = vStr
End Function
|
| |
