Private Sub sendFaxes_DblClick(Cancel As Integer)
Dim rst As DAO.Recordset, i As Integer
Dim fname As String  'Путь к файлу с текстом факса 
Dim VentaFax As String, FaxNumber As String, CommandString As String
Dim NickName As String
On Error GoTo err
VentaFax = "C:\Program Files\Venta\VentaFax & Voice 5\ventafax.exe"
If MsgBox("Отправляем факсы по списку внизу. Вы уверены?", vbOKCancel) = vbOK Then
Set rst = Me.VChild.Form.Recordset
rst.MoveFirst
    If rst.RecordCount >  0  Then
    Do Until rst.EOF
        If rst!Archive =  0  Then  'Посылаем только неархивную строчку 
FaxNumber = rst!FaxNumber
fname = rst!FilePath
NickName = rst!NickName
Debug.Print FaхNumber, NickName, fname
CommandString = "/t:" & FaxNumber & " /c:'" & NickName & "' /f:'" & fname & "' /s" & " /a2-"

i = ShellExecute(Application.hWndAccessApp, "open", VentaFax, CommandString,  0 , SW_HIDE)
 'MsgBox "Факс попал в расписание?", vbOKOnly 
        End If
mov:
    rst.MoveNext
    Loop
    End If
End If
ex:
Exit Sub
err:
If err.Number =  3000  Or err.Number =  3420  Then GoTo mov
MsgBox err.Number
GoTo ex
End Sub

Private Sub sendFaxes_DblClick(Cancel As Integer)
Dim fname As String  'Присоединяемый файл аттачмента 
Dim VentaFax As String, FaxNumber As String, CommandString As String
Dim NickName As String
Dim rst As DAO.Recordset, i As Integer
Dim WshShell, oExec
Dim locator As WbemScripting.SWbemLocator
Dim Service As WbemScripting.SWbemServices
Dim myob As WbemScripting.SWbemObjectSet
Dim myxz As WbemScripting.SWbemObject
Dim CtDist As Long
Dim PrStr As String
PrStr = "Venta*"

On Error GoTo err

VentaFax = "C:\Program Files\Venta\VentaFax & Voice 5\ventafax.exe"

If MsgBox("Отправляем факсы по списку внизу. Вы уверены?", vbOKCancel) = vbOK Then
Set rst = Me.VChild.Form.Recordset
    If rst.RecordCount >  0  Then
    rst.MoveFirst
        Do Until rst.EOF
        If rst!StatusID >  1  Then rst.MoveNext  'Посылаем только еще не посланную строчку 
FaxNumber = rst!FaxNumber
fname = rst!FilePath
NickName = rst!NickName
CommandString = "/t:" & FaxNumber & " /c:'" & NickName & "' /f:'" & fname & "' /s" & " /a2-"
rst.Edit
rst!TimeStamp = Now()
rst!StatusID =  2 
rst.Update

Set WshShell = CreateObject("WScript.Shell")
Set oExec = WshShell.Exec(VentaFax & " " & CommandString)

Debug.Print oExec.Status
Do While oExec.Status =  0 
Sleep  100 
Debug.Print CommandString
Loop
Debug.Print oExec.Status

Set oExec = Nothing
Set WshShell = Nothing

que:     'ОПРОС ОЧЕРЕДИ НА ПРИНТЕР VentaFax 

Set locator = New WbemScripting.SWbemLocator
Set Service = locator.ConnectServer
Set myob = Service.ExecQuery("SELECT *   FROM Win32_PrintJob ")
CtDist =  0 
For Each myxz In myob
Debug.Print myxz.Name
 If myxz.Name Like PrStr Then    'PrStr = "Venta*" 
   CtDist =  1 
 End If
Next myxz
Debug.Print "----- число заданий на принтере VentaFax--->"; CtDist
Set myob = Nothing
Set Service = Nothing
Set locator = Nothing

If CtDist >  0  Then GoTo que  'Если в очереди на VentaFax есть задания, то опрашиваем снова 

rst.MoveNext
        Loop
    Else
    MsgBox "Все факсы отправлены"
    End If

End If
ex:
Exit Sub
err:
MsgBox err.Number
MsgBox err.Description
GoTo ex

End Sub

Private Sub sendFaxes_DblClick(Cancel As Integer)
Dim fname As String  'Присоединяемый файл аттачмента 
Dim VentaFax As String, FaxNumber As String, CommandString As String
Dim NickName As String, Path As String
Dim rst As DAO.Recordset, i As Integer
On Error GoTo err

VentaFax = "C:\Program Files\Venta\VentaFax & Voice 5\ventafax.exe"

If MsgBox("Отправляем факсы по списку внизу. Вы уверены?", vbOKCancel) = vbOK Then
Set rst = Me.VChild.Form.Recordset
    If rst.RecordCount >  0  Then
    rst.MoveFirst
        Do Until rst.EOF
        If rst!StatusID =  1  Then  'Посылаем только еще не посланную строчку 
FaxNumber = rst!FaxNumber
fname = rst!FilePath
NickName = rst!NickName
CommandString = "/t:" & FaxNumber & " /c:'" & NickName & "' /f:'" & fname & "' /s" & " /a2-"
rst.Edit
rst!TimeStamp = Now()
rst!StatusID =  2 
rst.Update

Path = VentaFax & " " & CommandString
    i = ExecCmd(Path,  4 )
 'Анализ того как все прошло 
    If i <>  0  Then  ' 
        MsgBox "Произошла ошибка при выполнении команды:" & vbCrLf & _
        Path, vbCritical, "Внешнее приложение"
    End If
        End If
rst.MoveNext
        Loop
    Else
    MsgBox "Все факсы отправлены"
    End If

End If
ex:
Exit Sub
err:
MsgBox err.Number
MsgBox err.Description
GoTo ex

End Sub

Private Sub sendFaxes_DblClick(Cancel As Integer)
Dim fname As String  'Присоединяемый файл аттачмента 
Dim VentaFax As String, FaxNumber As String, CommandString As String
Dim NickName As String, Path As String
Dim rst As DAO.Recordset, i As Integer, FirstStep As Integer
Dim locator As WbemScripting.SWbemLocator
Dim Service As WbemScripting.SWbemServices
Dim myob As WbemScripting.SWbemObjectSet
Dim myxz As WbemScripting.SWbemObject
Dim CtDist As Long
Dim PrStr As String
On Error GoTo err
PrStr = "Venta*"
FirstStep =  0 

VentaFax = "C:\Program Files\Venta\VentaFax & Voice 5\ventafax.exe"

If MsgBox("Отправляем факсы по списку внизу. Вы уверены?", vbOKCancel) = vbOK Then
Set rst = Me.VChild.Form.Recordset
    If rst.RecordCount >  0  Then
    rst.MoveFirst
        Do Until rst.EOF
        If rst!StatusID =  1  Then  'Посылаем только еще не посланную строчку 
FaxNumber = rst!FaxNumber
fname = rst!FilePath
NickName = rst!NickName
CommandString = "/t:" & FaxNumber & " /c:'" & NickName & "' /f:'" & fname & "' /s" & " /a2-"
rst.Edit
rst!TimeStamp = Now()
rst!StatusID =  2 
rst.Update

Path = VentaFax & " " & CommandString
    i = ExecCmd(Path,  4 )
 'Анализ того как все прошло 
    If i <>  0  Then  ' 
        MsgBox "Произошла ошибка при выполнении команды:" & vbCrLf & _
        Path, vbCritical, "Внешнее приложение"
    End If
If FirstStep =  0  Then Sleep  5000 
FirstStep =  1 
que:     'ОПРОС ОЧЕРЕДИ НА ПРИНТЕР VentaFax 

Set locator = New WbemScripting.SWbemLocator
Set Service = locator.ConnectServer
Set myob = Service.ExecQuery("SELECT *   FROM Win32_PrintJob ")
CtDist =  0 
For Each myxz In myob
Debug.Print myxz.Name
 If myxz.Name Like PrStr Then    'PrStr = "Venta*" 
   CtDist =  1 
 End If
Next myxz
Debug.Print "----- число заданий на принтере VentaFax--->"; CtDist
Set myob = Nothing
Set Service = Nothing
Set locator = Nothing

If CtDist >  0  Then GoTo que  'Если в очереди на VentaFax есть задания, то опрашиваем снова 
        End If
rst.MoveNext
        Loop
    Else
    MsgBox "Все факсы отправлены"
    End If

End If
ex:
Exit Sub
err:
MsgBox err.Number
MsgBox err.Description
GoTo ex
End Sub

Private Sub sendFaxes_DblClick(Cancel As Integer)
Dim fname As String  'Присоединяемый файл аттачмента 
Dim VentaFax As String, FaxNumber As String, CommandString As String
Dim NickName As String, Path As String
Dim rst As DAO.Recordset, i As Integer, FirstStep As Integer
Dim locator As WbemScripting.SWbemLocator
Dim Service As WbemScripting.SWbemServices
Dim myob As WbemScripting.SWbemObjectSet
Dim myxz As WbemScripting.SWbemObject
Dim CtDist As Long
Dim PrStr As String, SQLString As String
On Error GoTo err
PrStr = "Venta*"
FirstStep =  0 
SQLString = "SELECT ID, McontentID, Archive, NickName, FaxNumber, " & _
"FilePath , Comment, StatusID, TimeStamp FROM Venta " & _
"WHERE ((Archive = 0) And (StatusID = 1)) ORDER BY NickName;"
 'Debug.Print SQLString 
VentaFax = "C:\Program Files\Venta\VentaFax & Voice 5\ventafax.exe"

If MsgBox("Отправляем факсы по списку внизу. Вы уверены?", vbOKCancel) = vbOK Then
 'Set rst = Me.VChild.Form.Recordset 

Set rst = CurrentDb.OpenRecordset(SQLString)
    If rst.RecordCount >  0  Then
    rst.MoveFirst
        Do Until rst.EOF
        If rst!StatusID =  1  Then  'Посылаем только еще не посланную строчку 
FaxNumber = rst!FaxNumber
fname = rst!FilePath
NickName = rst!NickName
CommandString = "/t:" & FaxNumber & " /c:'" & NickName & "' /f:'" & fname & "' /s" & " /a2-"
rst.Edit
rst!TimeStamp = Now()
rst!StatusID =  2 
rst.Update

Path = VentaFax & " " & CommandString
    i = ExecCmd(Path,  4 )
 'Анализ того как все прошло 
    If i <>  0  Then  ' 
        MsgBox "Произошла ошибка при выполнении команды:" & vbCrLf & _
        Path, vbCritical, "Внешнее приложение"
    End If
If FirstStep =  0  Then Sleep  5000 
FirstStep =  1 
que:     'ОПРОС ОЧЕРЕДИ НА ПРИНТЕР VentaFax 

Set locator = New WbemScripting.SWbemLocator
Set Service = locator.ConnectServer
Set myob = Service.ExecQuery("SELECT *   FROM Win32_PrintJob ")
CtDist =  0 
For Each myxz In myob
Debug.Print myxz.Name
 If myxz.Name Like PrStr Then    'PrStr = "Venta*" 
   CtDist =  1 
 End If
Next myxz
Debug.Print "----- число заданий на принтере VentaFax--->"; CtDist
Set myob = Nothing
Set Service = Nothing
Set locator = Nothing

If CtDist >  0  Then GoTo que  'Если в очереди на VentaFax есть задания, то опрашиваем снова 
        End If
rst.MoveNext
        Loop
    Else
    MsgBox "Все факсы отправлены"
    End If

End If
ex:
rst.Close
Set rst = Nothing
Exit Sub
err:
MsgBox err.Number
MsgBox err.Description
GoTo ex
End Sub

Option Compare Database
Dim FirstClick As Integer

Private Sub Form_Click()
On Error GoTo err
If FirstClick =  1  And Me.ActiveControl.Name = "Archive" Then
Me.FilterOn = Not Me.FilterOn
End If
FirstClick =  1 
Exit Sub
err:
Me.FilterOn = Not Me.FilterOn
Exit Sub
End Sub

Private Sub Form_Open(Cancel As Integer)
Me.Filter = "((Archive=0))"
Me.FilterOn = True
FirstClick =  0 
End Sub