Private Sub PERIODI()
Dim CMD As ADODB.Command, PERIODO As String, PRM As ADODB.Parameter, RS As ADODB.Recordset
PERIODO = "1SEM 2016"
If CONN Is Nothing Then
Set CONN = New ADODB.Connection
CONN.Open _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\DATABASE\SAL21.mdb;Persist Security Info=False;" & _
"Jet OLEDB:Engine Type=4;"
End If
Set CMD = New ADODB.Command
With CMD
Set .ActiveConnection = CONN
.CommandText = "Endquery"
.CommandType = adCmdStoredProc
Set PRM = .CreateParameter("[MYSTRING]", adVarChar, adParamInput, Len(PERIODO), PERIODO)
.Parameters.Append PRM
Set RS = CMD.Execute
Set CMD = Nothing
End With
End Sub
SQL = "SELECT *, venda.TotalS AS total_venda_agrupa, venda.totalc AS valor_total_venda, venda_forma_pagamento.descricao AS nome_forma_pagamento, vendaesc.QUANTIDADEprod as qtd, (vendaesc.QUANTIDADEprod * vendaesc.ValUniProd) As total_soma FROM vendaesc,venda INNER JOIN venda_forma_pagamento ON venda_forma_pagamento.cod = venda.forma_pagamento where vendaesc.data='" & DateRat & "' AND venda.cod = vendaesc.venda group By vendaesc.venda order by venda.cod"
prs.Open SQL, gConexao, adOpenStatic, adLockOptimistic, adCmdText
If prs.RecordCount = 0 Then
MsgBox "Não foi encontrado nenhum registro correspondente a sua consulta", vbOKOnly + vbInformation, "Atenção"
Exit Sub
End If
Do While Not prs.EOF
Set RptFPagamentoDetalhe_old.DataSource = prs
prs.MoveNext
Loop
RptFPagamentoDetalhe_old.Show vbModal'cdig = Format$(Now, "yyyy")
'DataReport1.Object.labCopy.Caption = "© " & cdig & " Company name."DataReport1.Sections("section5").Controls("labCopy").Caption =RS.Open "Select * from depenses where date()- ExpiryDate >= 30", DB, adOpenDynamic, adLockOptimistic
If Not RS.EOF Then
MsgBox rs!article & "will expire in less than a month"
ListView1.ListItems.Clear
Do While Not RS.EOF
With ListView2
Do While Not RS.EOF
With .ListItems.Add(, , "")
.SubItems(1) = RS("article")
.SubItems(2) = RS("ExpiryDate") & ""
RS.MoveNext
Loop
End With
End IfRS.Open "Select * from depenses where date()- ExpiryDate >= 30", DB, adOpenDynamic, adLockOptimistic
If Not RS.EOF Then
MsgBox rs!article & "will expire in less than a month"
ListView1.ListItems.Clear
Do While Not RS.EOF
With ListView2
Do While Not RS.EOF
With .ListItems.Add(, , "")
.SubItems(1) = RS("article")
.SubItems(2) = RS("ExpiryDate") & ""
RS.MoveNext
Loop
End With
End IfRS.Open "Select * from articles where date() - date_exp > 0 and date() - date_exp < 30", DB, adOpenDynamic, adLockOptimistic
If Not RS.EOF Then
MsgBox " some articles will expire in less than a month"
end if