Гость
Войти | Профиль | Очистить
Целевая тема:
Создать новую тему:
Автор:
Действия ...
Форумы / Microsoft Access [игнор отключен] [закрыт для гостей] / запуск процедуры / 14 сообщений из 14, страница 1 из 1
18.03.2016, 16:07
    #39195559
Komil_
Komil_
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
запуск процедуры
Добрый день!

Как запустить процедуру и подождать ровно 5 сек. и если работа процедуры не завершена, то прекратить принудительно?
5 секунд вполне достаточно.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
18.03.2016, 16:12
    #39195562
Konst_One
Konst_One
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
запуск процедуры
Код: vbnet
1.
2.
3.
4.
5.
6.
Dim cmd as ADODB.Command

...
cmd.CommandTimeout = 5
Set rs = cmd.Execute
...
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
18.03.2016, 17:17
    #39195609
Komil_
Komil_
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
запуск процедуры
Konst_One,

Прошу прощения, VBA процедуру, а не ХП.

P.S.
Может попробовать запустить запрос, который вызывает VBA процедуру вот таким макаром?
Если не найду другой способ попробую и такой вариант. Правда, как то не очень.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
18.03.2016, 17:28
    #39195628
Konst_One
Konst_One
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
запуск процедуры
внутри процедуры DoEvents и проверяйте время выполнения, как превысило, так выходите из неё
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
18.03.2016, 20:24
    #39195796
Komil_
Komil_
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
запуск процедуры
В MS Access есть у меня таблица, где хранятся VB скрипты. Специальной VBA процедурой запускаю VB скрипт.
Пытаюсь через VB скрипт программно установить связь с MS Excel. Если Excel занят (скажем, пользователь нажал на F2 или начал редактировать ячейку и курсор до сих пор мигает, или же открыл диалоговое окно и т.п.), то у меня скрипт висит.
Поэтому (после Вашего ответа) попробовал вот так:
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
Sub Test()
Dim X
Set X = GetExcel()
If LCase(TypeName(X)) <> "application" Then MsgBox "Невозможно установить связь с MS Excel.", vbInformation + vbSystemModal
End Sub

Function GetExcel()
Dim Xls, Start, i
Start = Now()
Do While IsEmpty(Xls)
    DoEvents
    Set Xls = GetObject(, "Excel.Application")
    If DateDiff("s", Start, Now()) >= 2 Then
        Exit Do
    ElseIf i > 2 Then
        MsgBox i
        Exit Do
    Else
        i = i + 1
    End If
Loop
If IsObject(Xls) Then Set GetExcel = Xls
End Function


Удивляет одно, вроде бы поставил 2 секунды, но почему то программа висит гораздо дольше и только потом пишет "Невозможно установить связь с MS Excel." Почему так?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
18.03.2016, 23:12
    #39195848
guest_rusimport
guest_rusimport
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
запуск процедуры
Komil_,
попробуйте этот вариант для решения своей задачи (во всяком случае, проверил - отрабатывает нормально, только библиотеку Excel не забудьте подключить)
4118354
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
19.03.2016, 05:57
    #39195900
Komil_
Komil_
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
запуск процедуры
guest_rusimport,

Спасибо за ссылку. Действительно работает гораздо быстрее.
Правда есть одна проблема, у разных юзеров разные офисы, поэтому раннее связывание не будет ли проблемой? Попробую экспериментировать и в этом направлении.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
19.03.2016, 06:16
    #39195905
Komil_
Komil_
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
запуск процедуры
guest_rusimport,

Странный код, точнее строка отмеченная красным цветом.
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
Private Sub Command1_Click()
Dim exApp As New Excel.Application

    Set exApp = GetObject(, "Excel.Application")

On Error GoTo rrr
    exApp.DisplayAlerts = False
On Error GoTo 0

    exApp.Range("A1").Select
    Set exApp = Nothing
    Exit Sub
    
rrr:
Set exApp = Nothing
End Sub


Здесь exApp = Excel.Application. Так? А в строке "exApp.Range("A1").Select" где Workbook? Где Worksheet? Почему не ругается?
Попробовал поздним связыванием. Сразу стал ругаться. Как так?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
19.03.2016, 09:11
    #39195917
MrShin
MrShin
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
запуск процедуры
Komil_
Код: vbnet
1.
exApp.Range("A1").Select



От селектов лучше избавиться совсем. Замените на exApp.GoTo. В старших версиях офиса наткнулся на проблему - возникает ошибка 1004 при попытке сделать селект на защищенном листе, даже если защита была снята VBA командой. Народ пишет, что селекты всегда были и остаются глючными.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
07.04.2016, 12:20
    #39210028
Aslonov M
Aslonov M
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
запуск процедуры
MrShin,

Привет Ребята !

Я подготовил модуль, но не могу его добавлять в запросах. Может вы мне поможете ?

Код: vbnet
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.
Public Sub Main()
    Debug.Print Format$(CDateEx("Sep 16 2008 18:40:07", "mdy"), "dmyyyy hh:nn:ss")
    Debug.Print Format$(CDateEx("17 9 2008 18:40:07", "dmy"), "dmyyyy hh:nn:ss")
    Debug.Print Format$(CDateEx("18-2008-Sep 18:40:07", "dym"), "dmyyyy hh:nn:ss")
    Debug.Print Format$(CDateEx("2008/sep/8 18:40:07", "ymd"), "dmyyyy hh:nn:ss")
End Sub
    
Public Function CDateEx(ss As String, Optional ByVal ymd As String = "ymd") As Date
    Dim i As Integer, st As String, sd As String, v As Variant, s As String, k As Integer, _
        m As Integer, d As Integer, y As Integer, j As Integer
    
    ymd = LCase$(ymd)
    i = InStrRev(ss, " ")
    If i Then
        st = Mid$(ss, i)
        ss = Trim$(Left$(ss, i - 1))
    End If
    
    ss = Replace(ss, "-", " ")
    ss = Replace(ss, "/", " ")
    ss = Replace(ss, ".", " ")
    
    v = Split(ss, " ")
    On Error GoTo Err_
    For i = 0 To UBound(v)
        s = v(i)
        If Len(s) Then
            k = k + 1
            If k = 4 Then GoTo Err_
            Select Case Mid$(ymd, k, 1)
                Case "d"
                    If IsNumeric(s) Then
                        d = CInt(s)
                        If d < 1 Or d > 31 Then GoTo Err_
                    End If
                Case "m"
                    If IsNumeric(s) Then
                        m = CInt(s)
                        If m < 1 Or m > 12 Then GoTo Err_
                    Else
                        s = LCase(Left$(s, 3))
                        For j = 1 To 34 Step 3
                            If s = Mid$("janfebmaraprmayjunjulaugsepoctnovdec", j, 3) Then
                                m = (j + 2) / 3: Exit For
                            End If
                        Next j
                    End If
                    If m = 0 Then GoTo Err_
                Case "y"
                    If IsNumeric(s) Then y = CInt(s)
            End Select
        End If
    Next i
    CDateEx1 = CDate(Format$(DateSerial(y, m, d), "yyyy.mm.dd") & " " & st)
    CDateEx = Format(CDateEx1, "dd-mm-yyyy")
    Exit Function

Err_:
    Err.Raise 513, , "&#209;&#242;&#240;&#238;&#234;&#224; &#241; &#228;&#224;&#242;&#238;&#233; &#241;&#238;&#228;&#229;&#240;&#230;&#232;&#242; &#238;&#248;&#232;&#225;&#234;&#243;"
End Function



Код: vbnet
1.
2.
3.
4.
?Format$(CDateEx("28-feb-16 00:00:00","dmy"), "ddmmyyyy")
28022016
?Format$(CDateEx("28-feb-16 00:00:00","dmy"), "ddmmyyyy")
28022016



Как мне добавить его в место Дата Рождении в данном запросе ?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
07.04.2016, 14:25
    #39210188
ПЕНСИОНЕРКА
ПЕНСИОНЕРКА
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
запуск процедуры
Aslonov M,

погоняла немного вашу функцию, прилагаю исправленный вариант
Код: vbnet
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.
Option Explicit



Public Sub Main()
Debug.Print Format$(CDateEx("Sep 16 2008 18:40:07", "mdy"), "dd/mm/yyyy hh:nn:ss")
Debug.Print Format$(CDateEx("17 9 2008 18:40:07", "dmy"), "dd/mm/yyyy hh:nn:ss")
Debug.Print Format$(CDateEx("18-2008-Sep 18:40:07", "dym"), "dd/mm/yyyy hh:nn:ss")
Debug.Print Format$(CDateEx("2008/sep/8 18:40:07", "ymd"), "dd/mm/yyyy hh:nn:ss")
'''''''''''error  выдается дата 12/12/2099-----------------------------------------------------
Debug.Print Format$(CDateEx("2008/sep/8 18:40:07", "ydm "), "dd/mm/yyyy error1")
Debug.Print Format$(CDateEx("2008", "ydm"), "dd/mm/yyyy error2")
End Sub
    
Public Function CDateEx(ss As String, Optional ByVal ymd As String = "ymd") As Date
    Dim i As Integer, st As String, sd As String, v As Variant, s As String, s1, s2, k As Integer, _
        m As Integer, d As Integer, y As Integer, j As Integer
    'Debug.Print "===="
    Debug.Print ss, ymd, "===="

    ss = Replace(ss, "-", " ")
    ss = Replace(ss, "/", " ")
    ss = Replace(ss, ".", " ")
    ss = Replace(ss, "  ", " ")
  

    v = Split("0 " & ss & " 0 0 0 ", " ")
    'Debug.Print v(0), v(1), v(2), v(3)
    ''On Error GoTo Err_
   
    For i = 1 To 3
        s = v(i)
        'Debug.Print s, Len(s)
        If Mid(ymd, i, 1) = "d" Then
        d = Val(s)
        If d = 0 Then GoTo Err_
        ElseIf Mid(ymd, i, 1) = "y" Then
        y = Val(s)
        If y = 0 Then GoTo Err_
        ElseIf Mid(ymd, i, 1) = "m" Then
        'm = s
        m = 0
         j = InStr("   jan feb mar apr may jun jul aug sep oct nov dec ", LCase(s))
         If j > 0 Then
         m = j / 4
         Else
         m = Val(s)
         End If
        If m = 0 Then GoTo Err_
        Else
        'GoTo Err_
        End If
            
       
    Next i
    CDateEx = DateSerial(y, m, d)
    'Debug.Print CDateEx
    Exit Function
''''''''''''''''''''''''''''''''''''''''''''''''
Err_:
s2 = "строка с датой содержит ошибку"
    ''Err.Raise 513, , "error=" & ss & " " & ymd & Chr(13) & Chr(10) & s2
Err.Clear
CDateEx = CDate("12/12/2099")
End Function
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
07.04.2016, 14:37
    #39210205
MrShin
MrShin
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
запуск процедуры
А так разве не работает?
Код: vbnet
1.
BirthDate: Format$(CDateEx([clbday],"dmy"), "ddmmyyyy")
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
07.04.2016, 15:42
    #39210326
\\\\
\\\\
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
запуск процедуры
ПЕНСИОНЕРКА, в первом случае ошибка потому, что шаблон нужно было изменить. А во втором - входные данные некорректны.

Aslonov M, зачем писать во все темы? Там не в своей 19018651 и сюда тоже залез.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
07.04.2016, 16:16
    #39210371
mds_world
mds_world
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
запуск процедуры
Модератор: Aslonov M, Вам предупреждение. При следующем вторжение в чужую тему сообщения будут удаляться.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
Форумы / Microsoft Access [игнор отключен] [закрыт для гостей] / запуск процедуры / 14 сообщений из 14, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение
созд. / загр.: 159ms
Закрыть
start [/forum/topic.php?fid=45&tablet=1&tid=1613712]:
 0ms
get settings:
 9ms
get forum list:
 11ms
check forum access:
 4ms
check topic access:
 4ms
track hit:
 43ms
get topic data:
 14ms
get forum data:
 3ms
get page messages:
 56ms
get tp. blocked users:
 2ms
others: 13ms
total:  159ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]