Importare dati da più files excel in access

[Dejavier]

Ciao a tutti,
avrei bisogno di importare dati da più file excel contenuti in una cartella in una determinata tabella di access.
I file excel hanno la stessa struttura ed i dati da importare sono contenuti in 2 fogli: il primo foglio "Informazioni generali" contiene 2 informazioni da ripetere in corrispondenza degli altri dati contenuti nel secondo foglio "Utenze domestiche".

Ho provato con un ciclo Do ... Loop ma funziona soltanto su 1 file.

Il ciclo dovrebbe inserire nella tabella di access "ud", tramite la query (INSERT INTO), i dati copiati da tutti i file fino a quando nel foglio "Utenze domestiche" non trova una cella vuota nella prima colonna.

Di seguito il codice con il Loop che copia correttamente i dati soltanto da 1 file: invece di lanciare la query ho inserito un Msgbox.

Vorrei quindi inserire un ciclo per eseguire la stessa operazione per tutti i files contenuti nella cartella ma non riesco.


Private Sub Comando1_Click()
Dim SourceDir As String
Dim app As Object
Dim file As Object
Dim foglio As Object
Dim riga As Integer
Dim query As String

riga = 2
SourceDir = "C:\Users\s.dedonato\Desktop\prova\" 'cartella da dove copiare tutti i files'
myFile = Dir(SourceDir & "\*.xls*") 'nome files da cui estrarre i dati'


Set app = CreateObject("Excel.Application")
Set file = app.Workbooks.Open(SourceDir & myFile)
Set anagrafica = file.worksheets("Informazioni generali")
Set foglio = file.worksheets("Utenze domestiche")

Do

If foglio.Cells(riga, 1) = "" Then
Exit Do
End If

MsgBox ("lancio query per il file" & myFile)

'query = "INSERT INTO ud(istat, comune, tipo_ut, ka, kb) VALUES('" & anagrafica.Cells(3, 2) & "','" & anagrafica.Cells(2, 2) & "','" & foglio.Cells(riga, 1) & "','" & foglio.Cells(riga, 2) & "','" & foglio.Cells(riga, 3) & "');"
'DoCmd.SetWarnings False 'disabilito gli avvisi
'DoCmd.RunSQL query 'lancia la query chiamata query
'DoCmd.SetWarnings True 'riattivo gli avvisi

MsgBox ("Istat - " & anagrafica.Cells(3, 2) & "," & "Comune - " & anagrafica.Cells(2, 2) & "," & "utenza - " & foglio.Cells(riga, 1) & "," & "ka - " & foglio.Cells(riga, 2) & "," & "kb - " & foglio.Cells(riga, 3))


riga = riga + 1 'per incrementare le righe per il ciclo


'Active.Workbook.Close = False 'non so se è utile chiudere il file dopo il loop

'myFile = Dir dovrei inserire un loop per far leggere tutti i file contenuti nella cartella

Loop

MsgBox ("arrivati in fondo")

End Sub


Grazie mille

 

[Dejavier]

Ho provato anche come di seguito con 2 file.

Il loop dovrebbe farlo per tutte le righe di ogni file fino a trovare uno spazio vuoto, una volta finito dovrebbe cambiare file e ricominciare.

In questo modo copia solo la prima riga del primo file e solo la seconda del secondo file. Dovrebbe copiare 6 righe da ogni file.
......
riga = 2
SourceDir = "C:\Users\s.dedonato\Desktop\prova\" 'cartella da dove copiare tutti i files'
myFile = Dir(SourceDir & "\*.xls*") 'nome files da cui estrarre i dati'

Do While myFile <> ""

Set app = CreateObject("Excel.Application")
Set file = app.Workbooks.Open(SourceDir & myFile)
Set anagrafica = file.worksheets("Informazioni generali")
Set foglio = file.worksheets("Utenze domestiche")


If foglio.Cells(riga, 1) = "" Then
Exit Do
End If

..........


'file.Workbooks.Close savechanges:=False 'serve per chiudere file dopo il loop

myFile = Dir() 'dovrei inserire un loop per far leggere tutti i file contenuti nella cartella

Loop

MsgBox ("arrivati in fondo")


End Sub



Se invece scrivo

.....
riga = 2
SourceDir = "C:\Users\s.dedonato\Desktop\prova\" 'cartella da dove copiare tutti i files'
myFile = Dir(SourceDir & "\*.xls*") 'nome files da cui estrarre i dati'

Do While myFile <> ""

Set app = CreateObject("Excel.Application")
Set file = app.Workbooks.Open(SourceDir & myFile)
Set anagrafica = file.worksheets("Informazioni generali")
Set foglio = file.worksheets("Utenze domestiche")

Do While foglio.Cells(riga, 1) <> ""

......
riga = riga + 1 'per incrementare le righe per il ciclo

Loop

'file.Workbooks.Close savechanges:=False 'serve per chiudere file dopo il loop

myFile = Dir() 'dovrei inserire un loop per far leggere tutti i file contenuti nella cartella

Loop

MsgBox ("arrivati in fondo")


End Sub

Copia le 6 righe del primo file e termina il Loop, sembra che così non veda il loop su myFile.
Le sto provando tutte ma non essendo molto pratico di vba non riesco a trovare la strada
Grazie ancora

 

[marino51]

ciao,
con 3 file funziona (office 2007)

Sub Macro1()
'SourceDir = "C:\Users\s.dedonato\Desktop\prova"
SourceDir = "e:\temp\ExcelTest\files"

Set objFSO = CreateObject("Scripting.FileSystemObject")

For Each myFile In objFSO.GetFolder(SourceDir).Files

    ' qui devi controllare l'estensione del file se nella cartella ci sono altri

    Set app = CreateObject("Excel.Application")
    Set file = app.Workbooks.Open(myFile)
'    Set anagrafica = file.Worksheets("Informazioni generali")
    Set foglio = file.Worksheets("Utenze domestiche")
    
    riga = 2

    Do While foglio.Cells(riga, 1) <> ""

'        ......

        riga = riga + 1

    Loop

    MsgBox ("file : " & myFile & "  righe : " & riga)

    'file.Workbooks.Close savechanges:=False
    file.Close

Next

MsgBox ("arrivati in fondo")
End Sub

ps, prova con "Set app =" esterna al "for", può non essere ripetuta per ogni file

 

[edwards142]

per imparare ad importare il file excel nel tuo database di Access, penso che i passaggi citati in questo tutorial sicuramente ti aiuteranno molto. Come ho anche imparato tanto da questo ... quindi basta controllare questo

Come importare i dati di Excel in database MS Access 2016