Newsgroup: it.comp.appl.access
Titolo: Creare file pdf (lungo)

Visto che qualcuno me l'ha chiesto, posto per tutti un modo per creare un
file pdf in automatico da un report di Access (97)
Io ho utilizzato PDFCreator, settato in modo da creare in automatico il file
PDF;
prima dell'esecuzione della stampa, in base ad alcuni parametri, vado a
modificare il file ini di pdfcreator per dirgli dove stampare e con quale
nome voglio chiamare il file e poi eseguo la stampa ...
La funzione per impostare il file ini si chiama INISetValue e devo averla
trovata sul sito comune o su internet ...
Chiedo scusa agli autori di queste funzioni se non li cito ma ho fatto il
tutto un pň di tempo fa e ho una certa fretta ...
Prendete questo esempio cosě com'č e scusate le imperfezioni, comunque a me
funziona!
__________________________________________________________
Codice sul pulsante nella maschera che stampa il report
'setto la stampante predefinita PDFCreator
    Dim stpPredefinita As String
    stpPredefinita = GetDefaultPrinter
    DefaultPrinter = stpPredefinita
    Dim stamp As String
    stamp = "PDFCreator"
    SetDefaultPrinter (stamp)
    Dim ValRit As Long
    Dim NomeFile As String
    Dim PercorsoINI As String
    Dim PercorsoPDF As String
    PercorsoINI = "dove si trova l'ini di pdfcreator"
    PercorsoPDF = "dove voglio mettere il file pdf"
    NomeFile = "filepdf"
    ValRit = INISetValue(PercorsoINI, "Options", "AutosaveFilename",
NomeFile)
    DoCmd.OpenReport "Nome del report", acViewNormal
    ResetDefaultPrinter
    Sleep (2000)
Invio anche un email con outlook
    Dim oOutlook As New Outlook.Application
    Dim oMessage As Outlook.MailItem
    Dim ns As Outlook.NameSpace
    Set ns = oOutlook.GetNamespace("MAPI")  'Return a reference to the MAPI
layer
    ns.Logon , , True, True  'Logon to exchange server
    Set oMessage = oOutlook.CreateItem(olMailItem)
    With oMessage
        .To = EMail
        .CC = Nz(CC, "")
        .Subject = Oggetto
        .Body = TestoEMail
        .Attachments.Add PercorsoPDF & NomeFile & ".pdf"
        .Display
'        .Send
'        .Save
    End With
    ns.Logoff       'Logoff Exchange
    Set ns = Nothing    'Cleanup
    Set oOutlook = Nothing
    Exit Sub
End Sub
MODULO per la gestione della stampante
Option Compare Database
Option Explicit
'************ Code Start **********
' This code was originally written by Dev Ashish.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Dev Ashish
'
Private Declare Function apiShellExecute Lib "shell32.dll" _
    Alias "ShellExecuteA" _
    (ByVal hwnd As Long, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) _
    As Long
'***App Window Constants***
Public Const WIN_NORMAL = 1         'Open Normal
Public Const WIN_MAX = 3            'Open Maximized
Public Const WIN_MIN = 2            'Open Minimized
'***Error Codes***
Private Const ERROR_SUCCESS = 32&
Private Const ERROR_NO_ASSOC = 31&
Private Const ERROR_OUT_OF_MEM = 0&
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&
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 Sub SetDefaultPrinter(S As String)
'imposta la stampante passata come argomento a predefinita
On Error GoTo Esci
Dim x As Long
If IsNull(S) Or S = "" Then Exit Sub
x = WriteProfileString("windows", "device", vbNullString)
DoEvents
x = WriteProfileString("windows", "device", S)
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
Function fHandleFile(stFile As String, lShowHow As Long)
Dim lRet As Long, varTaskID As Variant
Dim stRet As String
    'First try ShellExecute
    lRet = apiShellExecute(hWndAccessApp, vbNullString, _
            stFile, vbNullString, vbNullString, lShowHow)
    If lRet > ERROR_SUCCESS Then
        stRet = vbNullString
        lRet = -1
    Else
        Select Case lRet
            Case ERROR_NO_ASSOC:
                'Try the OpenWith dialog
                varTaskID = Shell("rundll32.exe shell32.dll,OpenAs_RunDLL "
_
                        & stFile, WIN_NORMAL)
                lRet = (varTaskID <> 0)
            Case ERROR_OUT_OF_MEM:
                stRet = "Error: Out of Memory/Resources. Couldn't Execute!"
            Case ERROR_FILE_NOT_FOUND:
                stRet = "Error: File not found.  Couldn't Execute!"
            Case ERROR_PATH_NOT_FOUND:
                stRet = "Error: Path not found. Couldn't Execute!"
            Case ERROR_BAD_FORMAT:
                stRet = "Error:  Bad File Format. Couldn't Execute!"
            Case Else:
        End Select
    End If
    fHandleFile = lRet & _
                IIf(stRet = "", vbNullString, ", " & stRet)
End Function
'************ Code End **********
MODULO per la gestione del file INI
Option Compare Database
Option Explicit
Private Declare Function GetPrivateProfileString Lib "Kernel32" Alias
"GetPrivateProfileStringA" _
     (ByVal lpApplicationName As String, _
     ByVal lpKeyName As Any, _
     ByVal lpDefault As String, _
     ByVal lpReturnedString As String, _
     ByVal nSize As Long, _
     ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "Kernel32" Alias
"WritePrivateProfileStringA" _
     (ByVal lpApplicationName As String, _
     ByVal lpKeyName As Any, _
     ByVal lpString As Any, _
     ByVal lpFileName As String) As Long
Public gsINIFile As String 'gs significa global string
'---------------------------------------------------------
' funzioni o sub di VB per rendere umana la gestione
' metterle nello stesso .bas delle precedenti
' si puo' semplificare se si vuole
'---------------------------------------------------------
Public Function INISetValue(INIFile As String, _
     INIGroup As String, _
     INIKey As String, _
     INIVAlue As String)
     ' update single line of .INI file
     ' NOTE: group and/or parameter line will be added if not already
present
     ' input: inifile=full path to .INI file, inigroup=group header (no [])
     ' inikey=parameter name, inivalue=new parameter value
     Call WritePrivateProfileString(INIGroup, INIKey, INIVAlue, INIFile)
End Function
Public Function INIGetValue(INIPath As String, INIGroup As String, INIKey As
String, INIDefault As String) As String
     ' get line from .INI file
     ' input: inpath=path to .INI file, INIgroup=group header (no [])
     ' inikey=parameter name, inidefault=default value
     ' output: value from file or default if not found
     Dim x As Long
     Dim sBuff As String * 512
     x = GetPrivateProfileString(INIGroup, INIKey, INIDefault, sBuff,
Len(sBuff), INIPath)
     INIGetValue = Left$(sBuff, x)
     End Function
Public Sub INIDeleteValue(INIPath As String, _
     INIGroup As String, _
     INIKey As String)
     ' delete line from .INI file (physically)
     ' input: inipath=path to .INI file, iniGroup=group header (no []),
     ' INIkey=parameter name
     Call WritePrivateProfileString(INIGroup, INIKey, 0&, INIPath)
End Sub
'---------------------------------------------------------
' queste vanno messe nello stesso bas
' sono le funzioni da usare nei vari form o moduli
' si puo' semplificare se si vuole, evitando le INIGetValue...
' e quindi scrivendo INIGetSettings e INISaveSettings
' usando direttamente GetPrivateProfileString e WritePrivateProfileString
' ma sono comode perche' semplificano la vita ed evitano di dover
specificare il file (gsINIFile)
'---------------------------------------------------------
Public Function INIGetSettings(INISection As String, _
  INIVar As String, _
  INIDefault As String) As String
  INIGetSettings = INIGetValue(gsINIFile, _
                  INISection, _
                  INIVar, INIDefault)
End Function
Public Sub INISaveSettings(INISection As String, _
     INIVar As String, _
     INIVAlue As String)
   INIDeleteValue gsINIFile, INISection, INIVAlue
   INISetValue gsINIFile, INISection, INIVar, INIVAlue
End Sub
' uso con il filename della variabile globale INIFile
' uso: ad esempio per salvare il valore <mio> nella variabile <ciao> del
gruppo <MostRecent> si usa:
'  INISaveSettings "MostRecent", "ciao", "mio"
' uso: ad esempio per recuperare il valore della variabile <ciao>  del
gruppo <MostRecent> si usa:
'        gsValore = INIGetSettings("MostRecent", "ciao", "-")
' "-" e' il valore di default


molto molto molto INTERESSANTE.
Grazie mille per aver postato tutto questo codice.
ho ancora un paio di problemi che devo risolvere
nome del file creato automaticamente e percorso dove salvarlo ma penso
che riuscirň presto a risolvere (spero)

ho modificato parecchia parte del codice e adesso posto quello che ho
realizzato io
in un modulo ho inserito questo codice
Option Compare Database
Option Explicit
'Read INI settings
Declare Function GetPrivateProfileString Lib "kernel32" Alias _
   "GetPrivateProfileStringA" (ByVal lpApplicationName As String, _
   ByVal lpKeyName As Any, ByVal lpDefault As String, _
   ByVal lpReturnedString As String, ByVal nSize As Long, _
   ByVal lpFileName As String) As Long
'Write settings
Declare Function WritePrivateProfileString Lib "kernel32" Alias _
   "WritePrivateProfileStringA" (ByVal lpApplicationName As String, _
   ByVal lpKeyName As Any, ByVal lpString As Any, _
   ByVal lpFileName As String) As Long
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Function ReadINIfile(sSection As String, sEntry As String, sFilename As
String) As String
Dim x As Long
Dim sDefault As String
Dim sRetBuf As String, iLenBuf As Integer
Dim sValue As String
'Six arguments
'Explanation of arguments:
'sSection: ini file section (always between brackets)
'sEntry : word on left side of "=" sign
'sDefault$: value returned if function is unsuccessful
'sRetBuf$ : the value you're looking for will be copied to this buffer
string
'iLenBuf% : Length in characters of the buffer string
'sFileName: Path to the ini file
sDefault$ = ""
sRetBuf$ = String$(256, 0)   '256 null characters
iLenBuf% = Len(sRetBuf$)
x = GetPrivateProfileString(sSection, sEntry, _
           sDefault$, sRetBuf$, iLenBuf%, sFilename)
ReadINIfile = Left$(sRetBuf$, x)
End Function
sull'evento di un bottone questo (poi andrò a modificarlo e metterlo in
una pubblic function)
Private Sub Comando23_Click()
'setto la stampante predefinita PDFCreator
    ''''vecchiastampantepredefinita =
    'Dim stpPredefinita As String
    'stpPredefinita = GetDefaultPrinter
    'DefaultPrinter = stpPredefinita
    'Dim stamp As String
    'stamp = "PDFCreator"
    'SetDefaultPrinter (stamp)
Dim tmpPrinter As Printer
Set tmpPrinter = Application.Printer
Application.Printer = Application.Printers("PDFCreator")
    Dim ValRit As Long
    Dim NomeFile As String
    Dim PercorsoINI As String
    Dim PercorsoPDF As String
    PercorsoINI = "E:\Documents and Settings\Negrinelli walter\Dati
applicazioni\PDFCreator\pdfcreator.ini" ''''settare il percorso dove si
trova il file pdfcreator
    PercorsoPDF = "c:\" ''''' settare il percorso dove si vuole salvare
il file
    NomeFile = "provailfilepdf" ''''settare il nome del file che si
vuole assegnare
    'ValRit = INISetValue(PercorsoINI, "Options", "AutosaveFilename",
NomeFile)
    Dim tmppercorsopdf As String
    'Dim tmpopercorsopdf As String
    Dim tmpnomefile As String
    tmppercorsopdf = ReadINIfile("Options", "AutosaveDirectory",
PercorsoINI) 'legge dal file
    'tmppercorsopdf = ReadINIfile("Options", "OAutosaveDirectory",
PercorsoINI) 'legge dal file
    tmpnomefile = ReadINIfile("Options", "AutosaveFilename",
PercorsoINI) 'legge dal file
    x = WritePrivateProfileString("Options", "AutosaveDirectory",
PercorsoPDF, PercorsoINI) 'scrive nel file
    x = WritePrivateProfileString("Options", "AutosaveFilename",
NomeFile, PercorsoINI) 'scrive nel file
    DoCmd.OpenReport "tabella1", acViewNormal ''''settareilnomedelreport
    'ResetDefaultPrinter
    Sleep (2000)
    x = WritePrivateProfileString("Options", "OAutosaveDirectory",
tmppercorsopdf, PercorsoINI) 'scrive nel file
    x = WritePrivateProfileString("Options", "AutosaveFilename",
tmpnomefile, PercorsoINI) 'scrive nel file
'Invio anche un email con outlook
    'Dim oOutlook As New Outlook.Application
    'Dim oMessage As Outlook.MailItem
    'Dim ns As Outlook.NameSpace
    'Set ns = oOutlook.GetNamespace("MAPI")  'Return a reference to the
MAPI
'layer
'    ns.Logon , , True, True  'Logon to exchange server
'    Set oMessage = oOutlook.CreateItem(olMailItem)
'    With oMessage
'        .To = EMail
'        .CC = Nz(CC, "")
'        .Subject = Oggetto
'        .Body = TestoEMail
'        .Attachments.Add PercorsoPDF & NomeFile & ".pdf"
'        .Display
'        .Send
'        .Save
'    End With
'    ns.Logoff       'Logoff Exchange
'    Set ns = Nothing    'Cleanup
'    Set oOutlook = Nothing
Application.Printer = tmpPrinter
    Exit Sub
End Sub
ciao a tutti