Eseguire una query da file vbs a database chiuso.

Question

Buon pomeriggio a tutti.

Ho creato un  DB che utilizzo come scadenziario ( e altre opzioni) dove in una tabella chiamata tb_items insieme ad altri campi ho 2 campi chiamati data_inizio e scadenza (formattati a data in cifre ) dove inserisco la data iniziale e la scadenza di un contratto.

Ho creato questa query che mi conta i contratti in scadenza (5 giorni prima della scadenza naturale).

SELECT tb_items.cliente, tb_items.titolo, tb_items.data_inizio, tb_items.scadenza, Count(*) AS Scadenza

FROM tb_items

WHERE (((DateDiff('d',Fix(Now()),[scadenza]))<5))

GROUP BY tb_items.cliente, tb_items.titolo, tb_items.data_inizio, tb_items.scadenza;

Inoltre da pulsante di comando su maschera lancio la function sottoriportata per conoscere lo stesso dato ( cioè la scadenza 5 giorni prima dei contratti)

Function Scadenze(Optional NumeroGiorni As Integer = 5) As Long

   Dim rs As DAO.Recordset

   Dim strSQL As String

   strSQL = "SELECT COUNT(*) AS Avviso FROM tb_items WHERE DateDiff('d',Fix(Now()),[scadenza])<" & NumeroGiorni

   Set rs = DBEngine(0)(0).OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)

   Scadenze = rs.Fields("Avviso").Value

   rs.Close

   Set rs = Nothing

End Function

Private Sub cmdAvvisoScadenze_Click()

Dim conta As Long

conta = 0

If Scadenze() > 0 Then

conta = conta + 1

   MsgBox "Attenzione ci sono " & conta & " scadenze in atto!"

   Else

   MsgBox " Attualmente non ci sono Polizze prossime alla scadenza!", vbInformation

End If

End Sub

Poiché la mia esigenza è sapere in anticipo i contratti che sono in scadenza almeno 5 giorni prima, è possibile farlo a database chiuso ( poiché in realtà non lo apro ogni giorno e corro il rischio di non conoscere i contratti in scadenza nel modo in cui ho progettato io il DB) magari eseguendo la query da un file vbs.

Mi aiutate a capire come fare per favore?

Ringrazio in anticipo chi mi aiuta in questo.

Ciao Nicola.

Answer 1

ciao Nicola,

boh...! avrei ipotizzato prima del tuo ultimo post il problema potesse essere legato a qualche impostazione/restrizioni in termine di sicurezza della cartella...ma se di fatto il file da access viene esportato da test che hai esdeguito non è così...

prova il workAround che segue....cancello il file prima dell'esportazione se esiste ed in seguito lo ri-creo.

Ho aggiunto una minima gestione errori....e qualche altra modifica qua e la...

ciao, Sandro.

option explicit

on error resume next

dim fso

const strPathName="tuoFullPathDatabase.accdb.accdb"  '<<<<<<<< da personalizzare

const strReportFullPath="tuoFullPathReportpdf.pdf"   '<<<<<<<< da personalizzare

Set fso = CreateObject("Scripting.FileSystemObject")

call openDB

set fso=nothing

With Err

       if .number<>0 then

            MsgBox "ERR#" & .Number _

            & vbNewLine & .Description _

           , vbOKOnly Or vbCritical

       end if

End With

sub openDB()

if not fso.fileexists(strPathName) then

 msgbox "database inesistente",vbcritical, "Attenzione"

 exit sub

end if

dim cnn, strConn, rst, lngRecNumber

Set cnn= CreateObject("ADODB.Connection")

Set rst= CreateObject("ADODB.Recordset")

strConn="Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strPathName & ";Mode=Read;"

cnn.open strconn

rst.open "tuaQuery",cnn   '<<<<<<<< da personalizzare

lngRecNumber=0

if not rst.eof then

    lngRecNumber=rst.fields(0).value

end if

msgbox "individuati: " & lngRecNumber & " contratti in prossima scadenza", vbinformation, "Informazione"

if lngRecNumber>0 then

     call printReport

     call sendEmail

end if

rst.close

cnn.close

set cnn=nothing

set rst=nothing

end sub

sub printReport()

Dim MyAccess

dim scadenze

Set MyAccess = CreateObject("Access.Application")

If Not MyAccess Is Nothing Then

   With MyAccess

        .OpenCurrentDatabase strPathName, false

        if fso.fileexists(strReportFullPath) then

           fso.deletefile strReportFullPath

        end if

        .docmd.OutputTo 3,"tuoReport","PDF Format (*.pdf)",strReportFullPath  '<<<<<<<< da personalizzare

        .quit

    End With

End If

set MyAccess=nothing

end sub

Sub sendEmail()

Dim outobj, mailobj

Set outobj = CreateObject("Outlook.Application")

Set mailobj = outobj.CreateItem(0)

With mailobj

    .To = "tuaemai@dominioit;******@dominio.it"

    .Subject = "invio report"

    .Body = "ciao, ti invio il report che trovi in allegato"

     .Attachments.add strReportFullPath

    .Display

  End With

Set outobj = Nothing

Set mailobj = Nothing

End sub

Answer 2

Ciao Sandro, buongiorno.

Ho adattato il tuo codice e i tuoi consigli al mio scenario, tutto funziona alla grande.

Ti chiedo solo di potermi seguire su un altro passaggio che intendo eseguire sempre all'interno del file vbs ( che dovrò richiamare poi ad un certo orario da una operazione pianificata di Windows) e cioè:

1. vorrei poter (nel caso ci fossero uno o più contratti in scadenza ) allegare un report ( già creato sulla query sottostante) ed inviarlo via e.mail a 10 destinatari diversi.

E' possibile farlo oppure no?

2. E' possibile inserire più routine vba ed eseguirle sempre all'interno del file vbs?

call openDB

sub openDB()

dim strPathName

 dim fso

 strPathName="C:\Users\SCADENZIARIO.accdb" '"tuoFullPathDatabase.accdb"

 Set fso = CreateObject("Scripting.FileSystemObject")

if not fso.fileexists(strPathName) then

  msgbox "database inesistente",vbcritical, "Attenzione"

  exit sub

 end if

dim cnn, strConn, rst

 Set cnn= CreateObject("ADODB.Connection")

 Set rst= CreateObject("ADODB.Recordset")

 strConn="Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strPathName

 cnn.open strconn

 rst.open "QueryContaScadenze",cnn

 msgbox "Individuati: " & rst.fields(0).value & "contratti in prossima scadenza", vbinformation, "Avviso Scadenze Polizze"

rst.close

 cnn.close

set cnn=nothing

 set rst=nothing

end sub

questa è la QueryContaScadenze

SELECT Count(*) AS Avviso

FROM tb_items

WHERE scadenza>date()-5;

questa è la query che da origine al Report da inviare via e.mail.

SELECT tb_items.cliente, tb_items.titolo, tb_items.data_inizio, tb_items.scadenza, Count(*) AS Scadenza

FROM tb_items

WHERE (((DateDiff('d',Fix(Now()),[scadenza]))<5))

GROUP BY tb_items.cliente, tb_items.titolo, tb_items.data_inizio, tb_items.scadenza;

Attendo con felicità una tua risposta Sandro.

Ciao Nicola.

Answer 3

ciao Nicola,

per la tua potresti provare ad adattare quella che segue:

SELECT Count(*) AS contaOrdini

FROM Ordini1

where dataordine>date()-5

questione di abitudine nel non utilizzare funzioni nella clausola where.

Ciao, Sandro.

Answer 4

Ciao Sandro, grazie per il tuo cortese intervento.  Prima di dover adattare la tua query al mio scenario, mi spieghi per favore perché il tuo predicato sql è totalmente diverso dal mio. Non potrebbe andare bene anche la mia query impostandola  con il tuo consiglio nel file vbs. Cioè otterrei lo stesso risultato della tua query adattata alla mia esigenza.  Grazie. Ciao Nicola.

Answer 5

ciao Nicola,

prova a rivedere il predicato Sql come segue, dove al posto di idordine inserisci la Pk che identifica il contratto e dataordine la data scadenza :

SELECT Count(*) AS contaOrdini

FROM (SELECT Ordini1.IDOrdine FROM Ordini1 WHERE Ordini1.DataOrdine>Date()-5)  AS DRV;

oppure :

SELECT count(*) as contaO

FROM Ordini1 as O inner join ( select idordine from Ordini1 where dataordine>date()-5 ) as o1 on o.idordine=o1.idordine

salvi la query come oggetto all'interno del database la chiami query1 e prova questo Vbs :

call openDB

sub openDB()

dim strPathName

dim fso

strPathName="tuoFullPathDatabase.accdb"

Set fso = CreateObject("Scripting.FileSystemObject")

if not fso.fileexists(strPathName) then

 msgbox "database inesistente",vbcritical, "Attenzione"

 exit sub

end if

dim cnn, strConn, rst

Set cnn= CreateObject("ADODB.Connection")

Set rst= CreateObject("ADODB.Recordset")

strConn="Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strPathName

cnn.open strconn

rst.open "query1",cnn

msgbox "individuati:" & rst.fields(0).value & " contratti in prossima scadenza", vbinformation, "Informazione"

rst.close

cnn.close

set cnn=nothing

set rst=nothing

end sub

HTH.

Ciao, Sandro.