Newsgroup: it.comp.appl.access
Titolo: Esportazione su un unico file

Ho creato un applicativo per una raccolta di dati da distribuire a degli utenti (basici!) che mi dovranno restituire.
Purtroppo ha già dimensioni di una 15 di mega (già sgonfiato) quindi temo che alcuni sistemi della loro posta (al momento di restituirmelo)  lo blocchino perchè troppo grande.
 
Sto pensando quindi di inserire un bottone che esporti in excel le tabelle e mi rispediscano quello.
 
Il sistema si compone di una decina di tabelle. Alcune di queste, avendo la stessa struttura, potrei unirle in una query di unione ma per le altre?
 
Voglio evitare di fargli fare più file ... quindi chiedo aiuto per fare un'esportazione unica. O un xls con più fogli ... o gestre una zippata dei file da vba ... o ... altro

Ho trovato QUASI la soluzione ... che condivido. Mi rimangono due problemi.
 
Non riesco a fare in modo che venga preso il percorso corrente dove salvare il file perchè se provo a scrivere:
 
Const cstrFullName = CurrentProject.Path & "\provaExport.xls"
 
mi dice che è necessaria un'espressione costante. 
Non sapendo quello che sarà il percorso dell'utente come risolvo? Vorrei evitare se possibile il C:
 
Altro problemino. I fogli vengono chiamati foglio 1,2... è possibile rinominare i fogli con il nome delle tabelle?
 
Terzo dubbio. Ho notato che funziona solo con le tabelle e non con le query. Non è indispensabile ma c'è modo di farlo?
 
Intanto se non disturba allego
 
Sub export2XLs2(ByVal strSql As String)
 
 
 Const cstrXlClass = "Excel.Application"
 Const cstrFullName = "C:\provaExport.xlsx"
 Const cstrCnn = "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0" _
              & ";Data Source=" & cstrFullName _
              & ";Mode=Read;"
 
Dim blnNotRunning      As Boolean
Dim strCnn             As String
Dim extractXlsFileName As String
 
With Application
     Set dbp = .CurrentProject
End With
 
If Not folderExists("C:\prova") Then MkDir "C:\prova"
 
strCnn = Replace(cstrCnn, cstrFullName, dbp.FullName)
 
blnNotRunning = getXlSinstance(xlApp, False, cstrXlClass)
 
With xlApp
    If blnNotRunning Then
       ' .Visible = True
       .ScreenUpdating = False
    End If
End With
 
 
If fileExists(cstrFullName) Then
    Set wbk = xlApp.Workbooks.Open(cstrFullName)
    With wbk.Worksheets
        .Add , , Count:=1
    End With
Else
    Set wbk = xlApp.Workbooks.Add
    With wbk
     For i = .Worksheets.Count To 2 Step -1
        .Worksheets.Item(i).Delete
     Next
    End With
End If
 
 
Set wsh = wbk.Worksheets.Item(1)
 
 With wsh
    Set xlQry = .QueryTables.Add(Connection:=strCnn _
                                     , Destination:=.Range("A1"))
 
End With
 
With xlQry
     .CommandType = 2      ' 2 è la costante per xlCmdSql
     .CommandText = strSql
     .AdjustColumnWidth = True
     .FieldNames = True
     .Refresh
     .Delete
End With
 
With xlApp
         .displayAlerts = False
        .ScreenUpdating = True
        .Calculation = -4105 'xlAutomatic
        '.Visible = False
         wbk.SaveAs FileName:=cstrFullName
         wbk.Close SaveChanges:=True _
              , FileName:=cstrFullName
        .displayAlerts = True
End With
 
    MsgBox "Salvato ed esportato", vbInformation, "Avviso"
 
End Sub
 
Private Function getXlSinstance(xlApp As Object _
                                , isXlsRunning As Boolean _
                                , strClass As String) As Boolean
    Err.Clear
    If isXlsRunning Then
        On Error Resume Next
        Set xlApp = GetObject(, strClass)
 
    End If
 
    If xlApp Is Nothing Then
        Set xlApp = CreateObject(strClass)
    End If
 
    If Err <> 0 Then
        MsgBox "Qualcosa non va controlla questo l'errore:" & Err.Description, _
                vbCritical, "Attenzione!!!"
        getXlSinstance = False
    Else
        getXlSinstance = True
    End If
 
End Function
 
Private Function fileExists(strFullPath As String) As Boolean
    On Error Resume Next
    fileExists = ((GetAttr(strFullPath) And vbDirectory) = 0)
End Function
 
Private Function folderExists(strPath As String) As Boolean
    On Error Resume Next
    folderExists = ((GetAttr(strPath) And vbDirectory) = vbDirectory)
End Function
 


non fai prima a condividere con loro una cartella su un drive e dire 
loro di buttare dentro il file quando hanno finito?
ciao

 loro di buttare dentro il file quando hanno finito?
 
... non li conosci ....
 


ah ok :-)
capito lo scenario
 

 ...
Ci sono tanti modi per esportare in Excel, formattare ecc. La tua roba 
con ADO, automazione ecc. per me sarebbe un po' esagerata se capisco 
bene cosa vuoi ottenere ed i 3 dubbi. Forse ti serve già:
 
 
Dim strPath As String
 
strPath = CurrentProject.Path & "\provaExport.xlsx"
 
DoCmd.OutputTo acOutputTable, "MiaTabella1", acFormatXLSX, strPath
 
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, _
	"MiaTabella_O_Query2", strPath, True, "MiaTabella_O_Query2"
 
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, _
	"MiaTabella_O_Query3", strPath, True, "MiaTabella_O_Query3"
 
'e così via per tutte le tabelle e query che vuoi esportare
 
 
Cioè, la prima esporti con OutputTo per creare un formato Excel giusto
  sulla macchina. Le altre tabelle+query aggiungi con 
TransferSpreadsheet, dove l'ultimo parametro imposta il nome della 
tabella di Excel.
 
Se preferisci il vecchio formato xls puoi usare acFormatXLS e 
acSpreadsheetTypeExcel9.
 
-- 
Ciao
Karl
*********
http://www.AccessDevCon.com
 
Access FAQ: 
http://www.donkarl.com/it
 

 
Come sempre un milione di grazie. E' perfetto