Newsgroup: it.comp.appl.access
Titolo: Report --> PDF (specificando nome file)

Salve,
lo so che probabilmente è una FAQ ma ho cercato per due ore e non ho trovato 
niente.
Vorrei:
stampare dei report access in formato PDF,
direttamente da codice
potendo specificare il path name del file pdf in modo che poi mi rimane una 
copia del file per archivio e posso (e questo lo so fare) mandarne una copia 
automatricamente per email.
Ho regolare licenza di Acrobat 6.0 FULL
Quindi mi basterebbe capire come fare per:
stampare sulla stampante "Acrobat" passando i parametri nome file e path 
file.
Ripeto ho cercato per 2 ore e non ho traovato niente di preciso...
Qualcuno mi aiuta? oppure: dove è la FAQ che cerco?
Grazie.
Simone 

 Simone
Ti allego il pezzo di codice, adattato sulla base di suggerimenti che ho
trovato nel NG e con Google, che utilizzo io:
    Private Sub SalvaOrdine_Click()
    Dim strPathDoc As String
    Dim Predefinita As String
    Dim strReport As String
    Dim stCriteriCollegamento As String
    Dim strFileName As String
 
    On Error GoTo Err_Stampa_Click
 
    strPathDoc = PathCorrente & "\OrdiniStampati\"
    Predefinita = Nz(GetDefaultPrinter, "")
    strReport = "StampaOrdiniProduzione"
    stCriteriCollegamento = "IDOrdine = Forms!OrdiniProduzione!IDOrdine"
    strFileName = "Order n° " & Forms!OrdiniProduzione!IDOrdine & ".pdf"
    gstrCallingForm = Me.NAME
    SetDefaultPrinter "Acrobat PDFWriter"
    Call SaveReportAsPDF(strReport, strPathDoc & strFileName,
stCriteriCollegamento)
    SetDefaultPrinter (Predefinita)
 
Exit_Stampa_Click:
    Exit Sub
Err_Stampa_Click:
    MsgBox err.description
    Resume Exit_Stampa_Click
 
End Sub
Credo sia abbastanza semplice da capire e, soprattutto, del tutto
trasparente.
TANNHAUSER
-- 
questo articolo e` stato inviato via web dal servizio gratuito 
http://www.newsland.it/news
 segnala gli abusi ad 
ab...@newsland.it

 TANNHAUSER
Mi pare, ma forse sbaglio...., che manchi qualche Funzione...!
Il Click è OK, ma le Funzioni di SetDefaultPrinter e SaveReportAsPDF
forse ti sono scappate....!
Ciao
@Alex
-- 
Posted via Mailgate.ORG Server - 
http://www.Mailgate.ORG

 @Alex
Ooops!! You're right, sorry.
Mi sono dimenticato di postare il codice da inserire in due distinti
moduli:
1. "ScegliStampante":
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 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
2. "SalvaOrdine":
'---------------------------------------------------------------------------------------------------------
'Questa sub č consigliabile che venga inserita in un modulo
'deve essere copiata cosě com'č
'---------------------------------------------------------------------------------------------------------
Option Compare Database
Option Explicit
 Public Const REG_SZ As Long = 1
   Public Const REG_DWORD As Long = 4
   Public Const HKEY_CLASSES_ROOT = &H80000000
   Public Const HKEY_CURRENT_USER = &H80000001
   Public Const HKEY_LOCAL_MACHINE = &H80000002
   Public Const HKEY_USERS = &H80000003
   Public Const ERROR_NONE = 0
   Public Const ERROR_BADDB = 1
   Public Const ERROR_BADKEY = 2
   Public Const ERROR_CANTOPEN = 3
   Public Const ERROR_CANTREAD = 4
   Public Const ERROR_CANTWRITE = 5
   Public Const ERROR_OUTOFMEMORY = 6
   Public Const ERROR_ARENA_TRASHED = 7
   Public Const ERROR_ACCESS_DENIED = 8
   Public Const ERROR_INVALID_PARAMETERS = 87
   Public Const ERROR_NO_MORE_ITEMS = 259
   Public Const KEY_QUERY_VALUE = &H1
   Public Const KEY_SET_VALUE = &H2
   Public Const KEY_ALL_ACCESS = &H3F
   Public Const REG_OPTION_NON_VOLATILE = 0
   Declare Function RegCloseKey Lib "advapi32.dll" _
   (ByVal hKey As Long) As Long
   Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias _
   "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _
   ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions _
   As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes _
   As Long, phkResult As Long, lpdwDisposition As Long) As Long
   Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias _
   "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _
   ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As _
   Long) As Long
   Declare Function RegQueryValueExString Lib "advapi32.dll" Alias _
   "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
   String, ByVal lpReserved As Long, lpType As Long, ByVal lpData _
   As String, lpcbData As Long) As Long
   Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias _
   "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
   String, ByVal lpReserved As Long, lpType As Long, lpData As _
   Long, lpcbData As Long) As Long
   Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias _
   "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
   String, ByVal lpReserved As Long, lpType As Long, ByVal lpData _
   As Long, lpcbData As Long) As Long
   Declare Function RegSetValueExString Lib "advapi32.dll" Alias _
   "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
   ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As _
   String, ByVal cbData As Long) As Long
   Declare Function RegSetValueExLong Lib "advapi32.dll" Alias _
   "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
   ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, _
   ByVal cbData As Long) As Long
'**********************************************************
Public Sub SaveReportAsPDF(strReportName As String, strPath As String,
stCriteriCollegamento As String)
    Dim strOldDefault As String
    strOldDefault =
QueryKey("Software\Microsoft\WindowsNT\CurrentVersion\Windows", "Device")
    SetKeyValue "Software\Microsoft\Windows NT\CurrentVersion\Windows",
"Device", "Acrobat PDFWriter", REG_SZ
    SetKeyValue "Software\Adobe\Acrobat PDFWriter", "PDFFilename",
strPath, REG_SZ
    SetKeyValue "Software\Adobe\Acrobat PDFWriter", "bExecViewer", 0,
REG_SZ
    DoCmd.OpenReport strReportName, , , stCriteriCollegamento
    SetKeyValue "Software\Microsoft\Windows NT\CurrentVersion\Windows",
"Device", strOldDefault, REG_SZ
End Sub
   Public Function SetValueEx(ByVal hKey As Long, sValueName As String,
lType As Long, vValue As Variant) As Long
       Dim lValue As Long
       Dim sValue As String
       Select Case lType
           Case REG_SZ
               sValue = vValue & Chr$(0)
               SetValueEx = RegSetValueExString(hKey, sValueName, 0&, _
                                              lType, sValue, Len(sValue))
           Case REG_DWORD
               lValue = vValue
               SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, _
   lType, lValue, 4)
           End Select
   End Function
   Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As _
   String, vValue As Variant) As Long
       Dim cch As Long
       Dim lrc As Long
       Dim lType As Long
       Dim lValue As Long
       Dim sValue As String
       On Error GoTo QueryValueExError
       ' Determine the size and type of data to be read
       lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
       If lrc <> ERROR_NONE Then Error 5
       Select Case lType
           ' For strings
           Case REG_SZ:
               sValue = String(cch, 0)
   lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, _
   sValue, cch)
               If lrc = ERROR_NONE Then
                   vValue = Left$(sValue, cch - 1)
               Else
                   vValue = Empty
               End If
           ' For DWORDS
           Case REG_DWORD:
   lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, _
   lValue, cch)
               If lrc = ERROR_NONE Then vValue = lValue
           Case Else
               'all other data types not supported
               lrc = -1
       End Select
QueryValueExExit:
       QueryValueEx = lrc
       Exit Function
QueryValueExError:
       Resume QueryValueExExit
   End Function
Public Function CreateNewKey(sNewKeyName As String, lPredefinedKey As Long)
    Dim hNewKey As Long         ' Handle to the new key
    Dim lRetVal As Long         ' Result of the RegCreateKeyEx function
    lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&,
vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hNewKey,
lRetVal)
    RegCloseKey (hNewKey)
End Function
Public Function SetKeyValue(sKeyName As String, sValueName As String,
vValueSetting As Variant, lValueType As Long)
    Dim lRetVal As Long         ' Result of the SetValueEx function
    Dim hKey As Long            ' Handle of open key
    ' Open the specified key
    lRetVal = RegOpenKeyEx(HKEY_CURRENT_USER, sKeyName, 0, KEY_SET_VALUE,
hKey)
    lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
    RegCloseKey (hKey)
End Function
Public Function QueryKey(sKeyName As String, sValueName As String)
    Dim lRetVal As Long         ' Result of the API functions
    Dim hKey As Long            ' Handle of opened key
    Dim vValue As Variant       ' Setting of queried value
    lRetVal = RegOpenKeyEx(HKEY_CURRENT_USER, sKeyName, 0,
KEY_QUERY_VALUE, hKey)
    lRetVal = QueryValueEx(hKey, sValueName, vValue)
    QueryKey = vValue
    RegCloseKey (hKey)
End Function
Public Function PathCorrente() As String
   'Autore: Paolo Holzl
   'Restituisce: il percorso completo del database corrente
   PathCorrente = Left(CurrentDb.NAME, Len(CurrentDb.NAME) - _
            Len(Dir(CurrentDb.NAME)))
End Function
Scuse ancora a Riker113 e un grazie per aver rimediato alla mia miopia a
Alessandro.


Siccome sapevo che il codice non inserito era tutto
quel malloppo di API mi pareva buona cosa....!
Manca forse la precisazione del fatto che per usare quanto
hai Postato serve la versione WRITER... o sbaglio, di Acrobat.
Ciao
-- 
@Alex (Alessandro Baraldi)
---------------------------------------------------------------------------
http://www.sitocomune.com/
http://www.mantuanet.it/alessandro.baraldi/
---------------------------------------------------------------------------

 hai Postato serve la versione WRITER... o sbaglio, di Acrobat.
La precisazione non occorre... basta leggere il post che ho iniziato io: ho 
chiesto come fare per stampare un pdf avendo Acrobat Full.
Ho già guardato un po' il codice. C'erano delle ripetizioni sulle funzioni 
per rilevare / settare la stampante di default.
Provo a dare una sistemata al tutto lo metto in un MDB con un esempietto e 
poi lo mando al sitocomune ovviamente *specificando molto bene* che non è 
farina del mio sacco... forse però occorre un esempio del genere sul sito. 
Almeno a me avrebbe rispermiato un paio di ore di ricerche inutili.

 ha scritto nel messaggio
news:cpd7mm$1sf3$1...@newsreader1.mclink.it...

Si a te on occorre, ma i messaggi nel NG sono Comuni, o meglio l'intento è
questo, e dato che Acrobat Full non è cosa che tutti possono permettersi di
acquistare ritengo doveroso sottolinearlo per evitare che qualcuno con poca
esperienza perda altre 2 ore....!
Saluti
