|
General |
| 6.112 Inviare da VBA una copertina e/o un report per FAX usando WinFax PRO 10.0 di Symantec |
| Roberto |
|
Nella funzione SendWinFax contenuta nel modulo Funzione IvioFax DDE del database di esempio allegato si opera facendo riferimento a DDE e il report è inviato usando la stampante WinFax che viene installata automaticamente durante l’installazione di WinFAx PRO 10.0 della Symantec. Per usare la suddetta funzione non è necessario aggiungere al database alcun particolare riferimento, in quanto non si fa uso di funzioni, oggetti o metodi SDK (Application Software Development Kit di WinFax PRO). La funzione SendWinFax permette di inviare per fax una copertina e/o un report a scelta. La funzione inoltre permette: 1) Di impostare il nome ed il numero di fax del destinatario. 2) Di impostare il nome dell’azienda del destinatario. 3) Di impostare il nome del report da inviare per fax. 4) Di impostare il testo della copertina. 5) Di impostare il tipo di copertina da usare: si può usare quella di default od indicare il path di una delle copertine contenute nel database copertine di WinFax. 6) Di impostare l’oggetto del fax. 7) Di impostare la data e l’orario di invio del fax se diversi da quelli correnti (invio differito). 8) Di decidere la risoluzione del fax. 9) Di decidere se visualizzare o meno la finestra di progressione di invio fax. Durante l’esecuzione della funzione occorre che il Controller di WinFax sia aperto. Se viene trovato chiuso, la funzione chiede di aprirlo ed eventualmente propone che l’apertura del Controller sia effettuato dalla funzione stessa. Per usare la funzione SendWinFax è necessario registrare in un modulo del database quanto contenuto nel modulo Printers del database di esempio allegato. La maggior parte delle funzioni contenute in tale modulo sono state prese da altre FAQ del Sito Comune. La funzione SendWinFax e quelle contenute nel modulo Printers sono state sviluppate e testate con Access 97 in ambiente Windows ME; si presupone però che funzionino anche anche con versioni successive di Access in ambienti operativi diversi da Windows ME. Quando viene aperto per la prima volta il database di esempio allegato, poiché la tabella rubrica telefonica è vuota, il programma chiede di inserire nella rubrica almeno un nominativo con il suo relativo numero di fax. Nel caso in cui non sia possibile aprire il database di esempio allegato, diamo qui di seguito il listato del codice VBA delle funzioni di cui sopra.
Declare Function FindWindow& Lib "user32" Alias "FindWindowA" _
(ByVal IpClassName As String, ByVal IpWindowName As String)
'********************************************************************************************
' Data: Marzo 2003
'
' La funzione SendWinFax trasmetterà per fax un report e lo indirizzerà al numero di fax
' che è stato fornito nella relativa variabile al momento del richiamo della funzione
'
' Questa funzione è stata solamente testata con Access 97 sotto Windows ME e usando
' WinFax PRO versione 10.0 di Symantec
'
'*********************************************************************************************
Function SendWinFax(strFaxName As Variant, strFaxNumber As Variant, strReportName As String, _
Destinatario As Variant, Oggetto As Variant, Orario As Variant, DataFAX As Variant, _
Finestra As Integer, FileCover As Variant, TestoCover As Variant, Risoluzione As Integer) As Integer
'strFaxName Variabile Stringa che contiene il nome del destinatario del FAX; può
' anche assumere il valore Null o la lunghezza zero
'strFaxNumber Variabile Stringa che contiene il numero di FAX; se NumeroFAX è Null o
' ha lunghezza zero, verrà chiesto di digitare un numero di FAX in una
' finestra di dialogo
'strReportName Variabile Stringa che contiene il nome del report che va inviato per fax.
' Può assumere anche il valore Null o avere lunghezza zero nel caso in cui
' si vuole usare la funzione per inviare solo una copertina
'Destinatario Variabile Stringa che contiene il nome della società del destinatario
' può anche assumere il valore null o avere lunghezza zero
'Oggetto Variabile Stringa che contiene l'oggetto del FAX;
' può anche assumere il valore Null o avere lunghezza zero
'Orario Variabile Stringa che contiene l'orario in cui inviare il FAX nella forma HH:nn:ss ;
' se ha un valore Null o ha lunghezza zero, il fax verrà inviato all'ora corrente.
'DataFAX Variabile Stringa che contiene la data di invio FAX nella forma mm/gg/aa ;
' se ha un valore Null o ha lunghezza zero, il FAX verrà trasmesso nella data odierna
'Finestra Variabile Intera che contiene il valore 1 la finestra di progressione va visualizzata;
' se il valore numerico è diverso da 1, la finestra non verrà visualizzata
'FileCover Variabile Stringa che contiene il path completo del file .CVP che contiene
' la copertina da usare; può anche assumere il valore Null o avere lunghezza zero
' nel caso non si vuole inviare una copertina o si vuole usare la copertina di default
'TestoCover Variabile Striga che contiene il testo del messaggio da scrivere nella copertina;
' può anche assumere il valore Null o avere lunghezza zero nel caso in cui non si vuole
' inviare per FAX una copertina ma solamente un report
'Risoluzione Variabile Intera che contiene il valore 1 se Alta risoluzione;
' Se il valore numerico è diverso da 1, verà impostata la bassa risoluzione
'**********************************
' Definizione di tutte le variabili
'**********************************
Dim Comodo As Variant
Dim lngChannelNumber As Long
Dim strFaxStatus As String
Dim strRecipFaxNum As String
Dim strRecipTime As String
Dim strRecipDate As String
Dim strRecipName As String
Dim strDestinatario As String
Dim strOggetto As String
Dim MioNumeroFAX As Variant
Dim strRecipient As String
'Attiva la routine per il trattamento personalizzato degli errori
On Error GoTo SendWinFax_Error
'****************************************************************
' Settaggio delle variabili con i parametri passati alla funzione
'****************************************************************
MioNumeroFAX = strFaxNumber
If Nz(strFaxNumber, "") = "" And Nz(strFaxName, "") = "" Then
' se il numero di fax ed il nome del destinatario
' non sono significativi fai digitare un numero di fax
MioNumeroFAX = InputBox("Digita un numero di FAX!", "Destinatario sconosciuto")
If MioNumeroFAX = "" Then
' se non è stato digitato un numero di fax, danne notizia e ...
MsgBox "Non hai digitato un numero di FAX!" _
& Chr$(10) & Chr$(13) & "Questo FAX non sarà inviato!", _
vbCritical + vbOKOnly, "Destinatario sconosciuto"
' ... imposta l'esito di invio a negativo ...
SendWinFax = 0
' ... ed esci dalla funzione
Exit Function
End If
Else
If Nz(strFaxNumber, "") = "" Then
' Se il numero di fax non è significativo
' fai digitare un numero di fax
MioNumeroFAX = InputBox("Digita il numero di FAX" & Chr$(10) & _
Chr$(13) & "di " & strFaxName, "Numero di FAX sconosciuto")
If MioNumeroFAX = "" Then
' Se non non è stato digitato un numero di fax, danne notizia e ...
MsgBox "Non hai digitato un numero di FAX!" _
& Chr$(10) & Chr$(13) & "Questo FAX non sarà inviato!", _
vbCritical + vbOKOnly, "Numero di FAX sconosciuto"
' ... imposta l'esito di invio a negativo ...
SendWinFax = 0
' ... ed esci dalla funzione
Exit Function
End If
End If
End If
strRecipFaxNum = Chr$(34) & MioNumeroFAX & Chr$(34)
strRecipTime = Chr$(34) & Nz(Orario, "") & Chr$(34)
strRecipDate = Chr$(34) & Nz(DataFAX, "") & Chr$(34)
strRecipName = Chr$(34) & Nz(Left$(strFaxName, 24), "") & Chr$(34)
strDestinatario = Chr$(34) & Nz(Mid(Trim(Destinatario), 1, 42), "") & Chr$(34)
strOggetto = Chr$(34) & Nz(Oggetto, "") & Chr$(34)
'Crea il recipiente di trasmissione
strRecipient = strRecipFaxNum & "," & strRecipTime & "," & strRecipDate & "," & strRecipName & _
"," & strDestinatario & "," & strOggetto
'*************************
' Inizio della sezione DDE
'*************************
' Verifica se il Controller di WinFax è attiva
If FindWindow("Cfaxmng", vbNullString) <= 0 Then
' Se Il Controller di WinFax non è attivo, danne notizia all'operatore
MsgBox "Il Controller di WinFax non è attivo", vbCritical + vbOKOnly, "Messaggio WinFax"
If Dir("C:\Programmi\WinFax\FAXMNG32.EXE") = "" Then
' Se il Controller NON è contenuto nella Directory C:\Programmi\WinFax
' richiedi che il Controller venga attivato manualmente ...
MsgBox "Attiva manualmente il Controller di WinFax", _
vbExclamation + vbOKOnly, "Messaggio WinFax"
Else
If MsgBox("Vuoi che lo attivo io automaticamente?", vbQuestion + vbYesNo, _
"Controller WinFax non Attivo") = vbYes Then
' Se il Controller è contenuto nella directory C:\Programmi\WinFax
' e l'operatore lo ritiene opportuno, attivalo
Comodo = Shell("C:\Programmi\WinFax\FAXMNG32.EXE", vbMinimizedNoFocus)
' Dai notizia all'operatore dell'avvenuta attivazione del Controller di WinFax
MsgBox "Ora il Controller di WinFax é attivo", vbInformation + vbOKOnly, "Messaggio WinFax"
' Continua l'invio del FAX
GoTo Riprova
End If
End If
' ... imposta l'esito di invio a negativo...
SendWinFax = 0
' ... ed esci dalla funzione
GoTo SendFax_Exit
End If
Riprova:
'Inizializza la connessione DDE
lngChannelNumber = DDEInitiate("faxmng32", "CONTROL")
'Legge lo stato della connessione DDE
strFaxStatus = DDERequest(lngChannelNumber, "STATUS")
' Se WinFax è occupato, cicla sino a quando non si libera
While strFaxStatus Like "Busy*"
strFaxStatus = DDERequest(lngChannelNumber, "STATUS")
Wend
'Imposta ChannelNumber con il Canale DDE corrente
lngChannelNumber = DDEInitiate("faxmng32", "TRANSMIT")
'Imposta il recioiente di trasmissione
DDEPoke lngChannelNumber, "Sendfax", "recipient(" & strRecipient & ")"
' Se il valore di Finestra è uguale a 1 ...
If Finestra = 1 Then
' ... imposta a SI la visualizzazione della finestra di dialogo
DDEPoke lngChannelNumber, "Sendfax", "showsendscreen(""1"")"
Else
' ... altrimenti imposta a NO la visualizzazione della finestra di dialogo
DDEPoke lngChannelNumber, "Sendfax", "showsendscreen(""0"")"
End If
' Se il valore di FileCover è significativo ...
If Nz(FileCover, "") <> "" Then
' ... imposta il nome del file .CVP che contiene il path completo
' della copertina che si vuole usare ...
DDEPoke lngChannelNumber, "Sendfax", "setcoverpage(" & Chr$(34) & FileCover & Chr$(34) & " )"
' Se il testo della copertina è significativo ...
If Nz(TestoCover, "") <> "" Then
' ... imposta il testo della copertina
DDEPoke lngChannelNumber, "Sendfax", "fillcoverpage(" & Chr$(34) & TestoCover & Chr$(34) & ")"
End If
End If
' Se il valore di Risoluzione è uguale a 1 ...
If Risoluzione = 1 Then
'Imposta ad Alta la risoluzione ...
DDEPoke lngChannelNumber, "SendFax", "resolution(""HIGH"")"
Else
' ... altrimenti impostala a Bassa
DDEPoke lngChannelNumber, "SendFax", "resolution(""LOW"")"
End If
' memorizza il nome della stampande predefinita nella variabile globale DefaultPrinter
' usando la funzione GetDefaultPrinter
DefaultPrinter = Left(GetDefaultPrinter, InStr(GetDefaultPrinter, ",") - 1)
' Imposta WinFax come stampante predefinita usando la funzione SetDefaultPrinter
Call SetDefaultPrinter("WinFax")
'Esegui il report da inviare per FAX
DoCmd.OpenReport strReportName, A_NORMAL
' Imposta a Vero l'esito dell'invio del FAX
SendWinFax = -1
SendFax_Exit:
' Termina tutti i collegamenti e resetta ChannelNumber
DDETerminateAll
lngChannelNumber = False
' ripristina il nome della stampante predefinita
Call ResetDefaultPrinter
Exit Function
'************************************
'* ROUTINE DI GESTIONE DEGLI ERRORI *
'************************************
SendWinFax_Error:
' visualizza il numero e la descrizione degli altri errori
MsgBox "Error:" + Error$, 0, "Invio FAX"
' esci dalla funzione
Resume SendFax_Exit
GoTo SendFax_Exit
End Function
‘**************************
Declare Function GetProfileSection& Lib "kernel32" Alias "GetProfileSectionA" (ByVal lpAppName As String, _
ByVal lpReturnedString As String, ByVal nSize As Long)
Declare Function GetProfileString& Lib "kernel32" Alias "GetProfileStringA" (ByVal lpAppName As String, _
ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long)
Declare Function WriteProfileString& Lib "kernel32" Alias "WriteProfileStringA" (ByVal lpszSection As String, _ ByVal lpszKeyName As String, ByVal lpszString As String)
Public DefaultPrinter As String
Public Function SostCar(s As String, c1 As String, c2 As String) As String
'sostituisce un carattere con un altro in una stringa (solo prima occorrenza)
Dim pos As Integer
pos = InStr(1, s, c1)
If pos > 0 Then Mid(s, pos) = c2
SostCar = s
End Function
Public Sub SetDefaultPrinter(s As String)
'imposta la stampante passata come argomento a predefinita
On Error GoTo Esci
Dim WshNetwork As Object
If IsNull(s) Or s = "" Then Exit Sub
Set WshNetwork = CreateObject("WScript.Network")
WshNetwork.SetDefaultPrinter (s)
Set WshNetwork = Nothing
DoEvents
Esci:
End Sub
Public Sub ResetDefaultPrinter()
'reimposta a predefinita la stampante memorizzata nella var globale
SetDefaultPrinter (DefaultPrinter)
End Sub
Public Function GetDefaultPrinter() As String
'ritorna il nome della stampante predefinita
Dim x As Integer
Dim buffer As String
buffer = Space$(255)
x = GetProfileString("windows", "device", "?", buffer, 255)
GetDefaultPrinter = Left$(buffer, x)
End Function
Download: |
