Importare in una tabella di Access dati provenienti da più file txt

Question

Buon pomeriggio a tutti.

Ho molti file txt in una cartella, dai quali devo estrapolare solo alcuni dati ed importarli in successione in una tabella di Access.

Ho iniziato a provare con un file txt di prova per poter iniziare la fase di importazione nella tabella ( per ora ho impostato solo un campo chiamato Matricola, ma nella realtà sono molto di più)

Il codice è il seguente:

Private Sub cmdImportaTxt_Click()

Dim StrTesto As String

Open Application.CurrentProject.Path & "\mio.txt" For Input As #1

' 1

Do Until EOF(1)

       Input #1, StrTesto

       If Len(StrTesto) <> 0 Then

            '2

            StrTesto = Mid$(StrTesto, 31, 8)

            '3

            CurrentDb.Execute "INSERT INTO tblProva ( Matricola ) SELECT '" & StrTesto & "'"

       End If

Loop

Close #1

End Sub

Il dato corrispondente alla Matricola nel file txt si trova nella posizione dell'immagine allegata.

In realtà, il codice non segnala nessun errore, però in tabella, al campo Matricola non è inserito alcun valore e la tabella si presenta in questo modo:

 Come devo fare per modificare il codice vba al fine di poter stabilire i riferimenti ai dati nel file txt poiché come potete notare dall'immagine della tabella ho altri campi da popolare.

Spero di essere stato chiaro.

Ringrazio chi mi aiuta in questo.

P.S.  dovrei indicare successivamente un ulteriore dettaglio per i dati da importare ( per ora mi limito a non creare confusione)

Ciao Nicola.

Answer 1

Pardon ho trovato un errore ti riposto il codice completo:

Option Compare Database

Option Explicit

Sub Importa()

 Dim InFile As Recordset

 Dim OutFile As Recordset

 Dim OutDettaglio As Recordset

 Dim Testo As String

 Dim NomeFile As String

 Dim Id_Corrente As Long

    Set OutFile = CurrentDb.OpenRecordset("Select * From tblProva")

    Set OutDettaglio = CurrentDb.OpenRecordset("Select * From tblDettaglio")

    NomeFile = Dir(Application.CurrentProject.Path & "\*.xlsx", vbNormal)

    Do While Len(NomeFile) > 0

       On Error Resume Next

       DoCmd.RunSQL ("Drop table Input")

       On Error GoTo 0

       DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "Input", Application.CurrentProject.Path & "" & NomeFile, False

       DoEvents

       DoCmd.RunSQL ("Alter Table Input Add Id Counter")

       Set InFile = CurrentDb.OpenRecordset("Select * From Input")

       Do While Not InFile.EOF

          Select Case InFile("ID")

                 Case Is = 5

                      OutFile.AddNew

                      OutFile("RicevutaNr") = InFile("F3")

                      OutFile("Del") = InFile("F6")

                 Case Is = 6

                      OutFile("CognomeNome") = InFile("F4")

                      OutFile("Matricola") = InFile("F12")

                 Case Is = 7

                      OutFile("Reparto") = InFile("F5")

                      Id_Corrente = OutFile("Id")

                      OutFile.Update

                 Case Is > 9

                      If IsNumeric(InFile("F2")) Then

                         OutDettaglio.AddNew

                         OutDettaglio("Id") = Id_Corrente

                         OutDettaglio("Qta") = InFile("F2")

                         OutDettaglio("Descrizione") = InFile("F3")

                         OutDettaglio("Taglia") = InFile("F7")

                         OutDettaglio("ContrattoNumero") = InFile("F8")

                         OutDettaglio("DataContratto") = InFile("F10")

                         OutDettaglio("NumeroProgressivo") = InFile("F11")

                         OutDettaglio.Update

                      Else

                         Exit Do

                      End If

           End Select

           InFile.MoveNext

       Loop

       InFile.Close

       Set InFile = Nothing

       NomeFile = Dir

    Loop

 OutFile.Close

 OutDettaglio.Close

 Set OutFile = Nothing

 Set OutDettaglio = Nothing

End Sub

Mimmo

Answer 2

Qui trovi il file che permette l'importazione di tutti i file .xlsx che si trovano nella cartella ImportazioneDati che si deve trovare nella stessa cartella dove si trova il file di access.

I file .xlsx una volta elaborati vengono cancellati.

Answer 3

Se ho capito devi creare 2 tabelle in una relazione 1 a n. Prova con:

Private Sub cmdImportaTxt_Click()

Dim OutFile As Recordset

Dim OutDettaglio As Recordset

Dim Testo As String

Dim Matricola As String

Dim Nome As String

Dim Qta As Integer

Dim Descrizione As String

Dim Taglia As String

Dim Riga As Long

Open Application.CurrentProject.Path & "\Nicola.txt" For Input As #1

Set OutFile = CurrentDb.OpenRecordset("Select * From tblProva")

Set OutDettaglio = CurrentDb.OpenRecordset("Select * From tblDettaglio")

Riga = 0

Do Until EOF(1)

   Riga = Riga + 1

   Input #1, Testo

   Select Case Riga

      Case Is = 27

           OutFile.AddNew

           Nome = Left$(Testo, 20)

           OutFile("CognomeNome") = Nome

      Case Is = 31

           Matricola = Left$(Testo, 8)

           OutFile("Matricola") = Matricola

      Case Is = 51

           OutDettaglio.AddNew

           OutDettaglio("Prova_Id") = OutFile("Id")

           Qta = Val(Testo)

           OutDettaglio("Qta") = Qta

      Case Is = 53

           Descrizione = RTrim(Testo)

           OutDettaglio("Descrizione") = Descrizione

      Case Is = 55

           Taglia = RTrim(Testo)

           OutDettaglio("Taglia") = Taglia

           OutDettaglio.Update

      Case Is = 65

           OutDettaglio.AddNew

           OutDettaglio("Prova_Id") = OutFile("Id")

           Qta = Val(Testo)

           OutDettaglio("Qta") = Qta

      Case Is = 67

           Descrizione = RTrim(Testo)

           OutDettaglio("Descrizione") = Descrizione

      Case Is = 69

           Taglia = RTrim(Testo)

           OutDettaglio("Taglia") = Taglia

           OutDettaglio.Update

      Case Is = 79

           OutDettaglio.AddNew

           OutDettaglio("Prova_Id") = OutFile("Id")

           Qta = Val(Testo)

           OutDettaglio("Qta") = Qta

      Case Is = 81

           Descrizione = RTrim(Testo)

           OutDettaglio("Descrizione") = Descrizione

      Case Is = 83

           Taglia = RTrim(Testo)

           OutDettaglio("Taglia") = Taglia

           OutDettaglio.Update

      Case Is = 93

           OutDettaglio.AddNew

           OutDettaglio("Prova_Id") = OutFile("Id")

           Qta = Val(Testo)

           OutDettaglio("Qta") = Qta

      Case Is = 95

           Descrizione = RTrim(Testo)

           OutDettaglio("Descrizione") = Descrizione

      Case Is = 97

           Taglia = RTrim(Testo)

           OutDettaglio("Taglia") = Taglia

           OutDettaglio.Update

   End Select

Loop

OutFile.Update

Close #1

OutFile.Close

OutDettaglio.Close

Set OutFile = Nothing

Set OutDettaglio = Nothing

End Sub

Ciao Mimmo

Answer 4

Ciao,

prova il seguente codice:

Option Compare Database

Option Explicit

Private Sub cmdImportaTxt_Click()

Dim OutFile As Recordset

Dim Testo As String

Dim Matricola As String

Dim Nome As String

Dim Riga As Long

Open Application.CurrentProject.Path & "\Nicola.txt" For Input As #1

Set OutFile = CurrentDb.OpenRecordset("Select * From tblProva")

Riga = 0

Do Until EOF(1)

   Riga = Riga + 1

   Input #1, Testo

   Select Case Riga

      Case Is = 27

           OutFile.AddNew

           Nome = Left$(Testo, 20)

           OutFile("CognomeNome") = Nome

      Case Is = 31

           Matricola = Left$(Testo, 8)

           OutFile("Matricola") = Matricola

   End Select

Loop

OutFile.Update

Close #1

OutFile.Close

Set OutFile = Nothing

End Sub

Facci sapere

Mimmo

Answer 5

Ciao Mimmo, ciao Carlo. Proverò il tutto domani mattina, sono fuori casa ora. Per quanto dici tu Carlo, non accadrà, poiche il file txt più lungo come righe e colonne l'ho postato, avevo già messo in conto questo. Nella realtà la maggior parte dei file sono più corti di quello pubblicato e tutti uguali come campi da importare. Vi ringrazio tantissimo per tutto quello che fate per noi e per me in particolare. Ciao Nicola.