Newsgroup: it.comp.appl.access
Titolo: importa fogli da excel

Ciao, il mio problema è questo:
- devo importare in un DB dei fogli excel (es.: nomi di vari dipendenti)
contenuti in un'unica cartella (es.: DittaX).
Il problema è che la cartella ha sempre lo stesso nome mentre i fogli con i
nomi dipendenti possono ovviamente cambiare.
Esiste (anche utilizzando VBA) un sistema per importare AUTOMATICAMENTE
tutti i fogli contenuti nella cartella a prescindere dai nomi di questi?
Oppure un sistema per rinominare in automatico i fogli della cartella DittaX
(e quindi importarli automaticamente in sequenza uno per uno).
Si tratta di circa 200 dipendenti e l'importazione deve avvenire una volta
al mese. Per questo mi sta a cuore la faccenda!!
grazie
ciao...   massimo


Il metodo piů casereccio.
Sul sitocomune, c'č una funzione che ti permette
di creare una tabella temporanea dei file presenti
in una directory.
Importi i file presenti, poi ti crei un piccolo
ciclo per determinare il file che vuoi importare e
lanci l'importazione.
MAssimiliano

 ha scritto nel messaggio
news:POvoc.50421$Qc.20...@twister1.libero.it...

Questo esempio apre il file excel, legge i nomi dei fogli e crea una tabella
(chiamata "daFoglioExcel_" + nome foglio) per ogni foglio;
(es.)
On Error GoTo leggiFoglioExcel_err
Dim oApp As Excel.Application, wkBk As Excel.Workbook, wkSh As
Excel.Worksheet
Set oApp = CreateObject("Excel.Application")
Set wkBk = oApp.Workbooks.Open("c:\documenti\nomeFile.xls")
DoCmd.SetWarnings False
For Each wkSh In wkBk.Worksheets
    MsgBox wkSh.Name
    DoCmd.RunSQL "SELECT * INTO [daFoglioExcel_" & wkSh.Name & "] FROM [" &
wkSh.Name & "$] IN 'c:\documenti\nomeFile'[EXCEL 5.0;];"
Next
DoCmd.SetWarnings True
leggiFoglioExcel_exit:
    Set wkSh = Nothing
    Set wkBk = Nothing
    Set oApp = Nothing
    Exit Sub
leggiFoglioExcel_err:
    DoCmd.SetWarnings True
    Set wkSh = Nothing
    Set wkBk = Nothing
    Set oApp = Nothing
    MsgBox Err.Number & ", " & Err.Description
Prima di utilizzarla devi inserire i riferimenti alla libreria di Microsoft
excel...
Ciao.
--
Sergio MAZZA

 ha scritto nel messaggio
news:c7vvl8$guj$1...@canarie.caspur.it...

GRAZIE A TUTTI RAGAZZI!! PROBLEMA RISOLTO.
ciao ... massimo

 ha scritto nel messaggio
news:c7vvl8$guj$1...@canarie.caspur.it...

Ho utilizzato questo tuo codice per la creazione di un tool, inserendo altro
codice che mi consentisse di recupare i dati dalle celle.
Purtroppo succedde che nonostante si imposti "Set oApp = Nothing" non sempre
l'applicazione Excel viene elimanata dal Task Manager, provocando problemi
al successivo riutilizzo.
Quale potrebbe essere la causa?
Grazie
Ciao
Eugenio

 Eugenio
Il codice?
Ciao.
-- 
Sergio MAZZA

 Ciao.
Ho trovato il problema.
Manca la chiusura dell'applicazione. Col senno di poi: ovviamente.
Per informazione riporto il tuo codice
    ...
    ...
    ...
    Set wkSh = Nothing
    Set wkBk = Nothing
    Set oApp = Nothing
    Exit Sub
    ...
    ...
e quello che ho corretto
    ...
    ...
    ...
    Set wkSh = Nothing
    wkBk.Close
    Set wkBk = Nothing
    oApp.Application.Quit
    Set oApp = Nothing
    Exit Sub
    ...
    ...
Nel tuo caso può essere che l'applicazione, non essendo complessa, riesca a
"autochiudersi", mentre nel mio caso essendo decisamente più pesante, perchè
prevede la lettura di ogni singola cella, non è in grado di chiuderla.
Sono supposizioni ovviamente.
:-)
Grazie
Ciao
Eugenio

"Eugenio" <Ci...@Eugenio.it> ha scritto nel messaggio
news:c8fl3c$plu$1...@lacerta.tiscalinet.it...

E' più facile che mi sia scordato di inserire quella riga visto che si
tratta di un esempio che riadatto per problemi simili...
Ciao.
-- 
Sergio MAZZA

"Sergio MAZZA"  ha scritto nel messaggio > >     ...

Buongiorno
Ieri ti ho scritto che avevo trovato la soluzione, ma purtroppo non sempre
funziona.
Ho rilevato che se ho un foglio che contiene circa 50 righe il programma
viene eseguito reogalrmente e Excel viene scaricato. Se però provo con un
numero maggiore, il programma termina regolarmente, eseguendo tutti gli
aggiornamenti,  e istruzioni di disattivazione degli oggetti, ma di fatto
resta attivo Excel con tutti i problemi che ne conseguono.
Infatti per poter riutilizzare il programma, che si blocca al primo clic,
devo terminare Excel dal task Manager.
Ma come è possibile?
Grazie
Ciao
Eugenio

 Eugenio
Non ne ho idea, specie se non vedo il codice; invia tutta la routine e
indica (se c'è) il punto dove si ferma l'esecuzione del codice...
Ciao.
-- 
Sergio MAZZA


La/le routine sono un blocco un po' troppo grosso per essere inviate, ma ti
assicuro che l'aplicazione non si blocca. Ho inserito un punto
d'interruzione poco prima del blocco di chiusura e ho verificato che le
istruzioni vengono eseguite tutte.
Grazie
Ciao
Eugenio

"Eugenio" <Ci...@Eugenio.it> ha scritto nel messaggio
news:c8i0vh$q6s$1...@lacerta.tiscalinet.it...

Se sei sicuro non posso fare nulla allora...
Ciao.
-- 
Sergio MAZZA

 Ciao.
Quella che segue è la sub in questione. Prima di questa ci sono altre due
sub che utilizzano Excel: la prima serve per selezionare il foglio e la
seconda estrare l'elenco delle colonne che compongono il foglio.
Private Sub Importazione()
Dim oApp As Excel.Application
Dim wkBk As Excel.Workbook
Dim wkSh As Excel.Worksheet
Dim dbST As DATABASE
Dim rsST As Recordset
Dim rsCP As Recordset
Dim rsColl As New Collection
Dim i As Integer
Dim iRigheImp As Integer
Dim intRowIndex As Integer
Dim iR As Integer
Dim intColIndex As Integer
Dim iC As Integer
Dim blInsert As Boolean
Dim blErrore As Boolean
On Error GoTo Err_Importazione
    DoCmd.Hourglass True
    iRigheImp = 0
    Set oApp = CreateObject("Excel.Application")
    Set wkBk = oApp.Workbooks.Open(Me!Percorso)
    i = Me!Foglio.Column(1)
    Set wkSh = wkBk.Worksheets(i)
    Set dbST = CurrentDb
    Set rsCP = dbST.OpenRecordset("Clienti", dbOpenDynaset, dbSeeChanges)
    iR = 0
    'Lettura righe del foglio a partire dalla riga 2, perchè la riga 1
contiene le intestazioni
    For intRowIndex = 2 To 9999
        If wkSh.Cells(intRowIndex, 1) > "" Then
            blInsert = False
            iC = 0
            'Lettura colonne del foglio
            For intColIndex = 1 To 250
                If Trim(wkSh.Cells(1, intColIndex)) > "" Then
                    Set rsST = dbST.OpenRecordset("Select NomeTabella,
NomeCampo, TipoCampo, LunghezzaCampo, ColonnaFoglio " & _
                                                  "From StrutturaTabelle " &
_
                                                  "Where NomeTabella =
'UniClientiPotenziali' and ColonnaFoglio = '" &
Trim(SostituisciStringa(wkSh.Cells(1, intColIndex), "'", " ")) & "'")
                    If rsST.EOF = False Then
                        If blInsert = False Then
                            rsCP.AddNew
                            rsCP!RagioneSociale = ""
                            rsCP!Indirizzo = ""
                            rsCP!Citta = ""
                            rsCP!Cap = ""
                            rsCP!Provincia = ""
                            rsCP!Zona = ""
                            rsCP!nazione = ""
                            rsCP!NrTelefono = ""
                            rsCP!NrFax = ""
                            rsCP!Email = ""
                            blInsert = True
                        End If
                        If wkSh.Cells(intRowIndex, intColIndex) > "" Then
                            Select Case rsST!NomeCampo
                                Case "RagioneSociale": rsCP!RagioneSociale =
Mid(Trim(wkSh.Cells(intRowIndex, intColIndex)), 1, 100)
                                Case "Indirizzo":      rsCP!Indirizzo =
Mid(Trim(wkSh.Cells(intRowIndex, intColIndex)), 1, 100)
                                Case "Cap":            rsCP!Cap =
Mid(Trim(wkSh.Cells(intRowIndex, intColIndex)), 1, 10)
                                Case "Citta":          rsCP!Citta =
Mid(Trim(wkSh.Cells(intRowIndex, intColIndex)), 1, 50)
                                Case "Provincia":      rsCP!Provincia =
Mid(Trim(wkSh.Cells(intRowIndex, intColIndex)), 1, 2)
                                Case "Zona":           rsCP!Zona =
Mid(Trim(wkSh.Cells(intRowIndex, intColIndex)), 1, 3)
                                Case "Nazione":        rsCP!nazione =
Mid(Trim(wkSh.Cells(intRowIndex, intColIndex)), 1, 50)
                                Case "NrTelefono":     rsCP!NrTelefono =
Mid(Trim(wkSh.Cells(intRowIndex, intColIndex)), 1, 30)
                                Case "NrFax":          rsCP!NrFax =
Mid(Trim(wkSh.Cells(intRowIndex, intColIndex)), 1, 30)
                                Case "Email":          rsCP!Email =
Mid(Trim(wkSh.Cells(intRowIndex, intColIndex)), 1, 100)
                            End Select
                        Else
                            iC = iC + 1
                            If iC = 3 Then Exit For
                        End If
                    End If
                    rsST.Close
                    Set rsST = Nothing
                End If
            Next intColIndex
            If blInsert = True Then
                rsCP!ItaliaEstero = "I"
                'Prima di aggiornare viene verificato se il cliente esiste
già nella tabella
                blErrore = False
                Call ControllaEsistenzaCliente(rsCP!RagioneSociale,
rsCP!Indirizzo, rsCP!Citta, rsCP!Cap, rsCP!Provincia, rsCP!Zona,
rsCP!nazione, rsCP!NrTelefono, rsCP!NrFax, rsCP!Email, blErrore)
                If blErrore = False Then
                    rsCP.Update
                    iRigheImp = iRigheImp + 1
                    blInsert = False
                Else
                    'rsCP.Delete
                End If
            End If
        Else
            iR = iR + 1
            If iR = 3 Then Exit For
        End If
    Next intRowIndex
    rsCP.Close
    Set rsCP = Nothing
Exit_Importazione:
    Set wkSh = Nothing
    wkBk.Close
    Set wkBk = Nothing
    oApp.Application.Quit
    Set oApp = Nothing
    MsgBox "Importazione terminata." & vbCr & "Sono state importate " &
Trim(str(iRigheImp)) & " righe.", vbInformation, "Importazione Clienti"
    Forms!Sk_AnagCliPotenziali.Requery
    Me.SetFocus
    DoCmd.Hourglass False
    DoCmd.Close
    Exit Sub
Err_Importazione:
    MsgBox ERR.number & " - " & ERR.description
    Resume Exit_Importazione
End Sub
Ciao
Grazie
Eugenio

"Eugenio" <Ci...@Eugenio.it> ha scritto nel messaggio
news:c8i5gk$u07$1...@lacerta.tiscalinet.it...

Il problema si è risolto sostituendo a
Dim oApp As Excel.Application
Dim wkBk As Excel.Workbook
Dim wkSh As Excel.Worksheet
le seguenti Dim
Dim oApp As Object
Dim wkBk As Object
Dim wkSh As Object
Grazie
Ciao
Eugenio