Форумы HiProg.com - MS ACCESS, VBA, VB

 

Ответить на сообщение

Вернуться к теме

Вы отвечаете на сообщение:

ник: dillinger
На моем компе (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


Ваше имя:

Пароль:
Цитировать: [quote][/quote] Код: [code][/code]
Жирный: [b][/b] Наклонный: [i][/i]
URL: [url][/url] 

Сообщение:

 Размер файла не более 50 Кбт. Большие файлы можно размещать на www.slil.ru

Прикрепить:

 

Для вставки смайлов в текст щелкните по значку.