.txt files automatisch importeren in excel

[JohnBoat]

Goedenavond!

Hopelijk kan iemand mij helpen met het volgende:

Ik ben op dit moment handmatig 800 files aan het intikken in een database. Het zijn .txt files waarbij ik enkele waarden nodig heb, deze kan ik dan in een online database invoeren. Als het mij lukt om de .txt files automatisch in excel in te lezen, kan ik ze daarna bulk importen in de online database. Dat gaat mij 50+ uur schelen.

Het betreft een .txt file waar ik slechts enkele waarden nodig heb (onderaan de verschillende posities (events & procentueel aantal). Deze wil ik dan graag geïmporteerd in een excel bestand (maar dan horizontaal). In de bijlage heb ik een voorbeeld van de txt file en een excel file hoe ik dit zou willen hebben.

Is hier een mogelijkheid voor om dit relatief automatisch te doen met meerdere files tegelijk? Of is er wellicht een script beschikbaar die dit mogelijk maakt?
Wel goed om te weten: deze waarden staan niet altijd op dezelfde regel, maar wel altijd onderaan het document. Alle tips zijn welkom!

(Het gaat over onderzoek in een ziekenhuis, dus je helpt er ook nog mensen mee)

Alvast dank.

Groeten,

John

 

[alphamax]

Welkom op het forum.
Ik denk dat verschillende gevorderde leden van dit forum je al kunnen helpen, de VBA code die hiervoor nodig is, is niet zo moelijk.

 

[JEC.]

Hier alvast een voorzetje. Het enige wat er nog moet gebeuren is een loop door je textfiles.
Ben er even van uitgegaan dat de data altijd hetzelfde is opgebouwd en tussen de streepjes staat.

Even je pad aanpassen en je kunt testen.

Sub jvr()
  c00 = "C:\users\...\Downloads\txt file 1.info.txt"
   With CreateObject("scripting.filesystemobject").opentextfile(c00)
     ar = Split(Replace(Split(Join(Split(.readall, vbLf)), "%")(1), "-", ""), " ")
        ReDim jv(UBound(ar))
           For i = 0 To UBound(ar)
              If IsNumeric(ar(i)) Then jv(j) = ar(i): j = j + 1
           Next
        Sheets(2).Cells(2, 2).Resize(, j - 1) = jv
   End With
End Sub

 

[JohnBoat]

Dank jullie voor de snelle reactie! Het is inderdaad mijn eerste keer op het forum. Heel fijn dat er mensen zijn die bereidt zijn om mij te helpen. Het betreft dus wetenschappelijk onderzoek in het ziekenhuis; helaas niet zo veel ervaring met programmeren of codes schrijven; dus vandaar mijn post op dit forum.

Beste JVeer,

Helaas heb ik echt nul ervaring met VBA, dus excuseer mijn wellicht stomme vragen. Als dit uiteindelijk gaat lukken, ben ik jullie enorm dankbaar.
Ik heb nogmaals een excel sheet toegevoegd + 4 van de .txt betanden die ik heb. Dan kunnen jullie het verschil zien tussen de bestanden.
data die ik nodig heb is: start date, start time, CSV duration en de verschillende posities in # en %.
Deze posities staan dus onderaan het document (altijd onder os #events %)
In excel document staat eigenlijk hoe ik de Bulk import uiteindelijk in de database ga zetten.

Nog een goude tip/ tutorial die ik kan bekijken voor het werken met VBA?
Het pad heb ik aangepast.
Tijdens het runnen van de VBA code stuit ik op de volgende foutcode:
Het subscript valt buiten bereik: Sheets(2).Cells(2, 2).Resize(, j - 1) = jv

Doe ik hier iets fout? Of heeft het te maken met de verschillen tussen de bestanden?

Alvast veel dank.

 

[alphamax]

De eerste regel bevatten de sleutels waarmee in de tekst bestanden wordt gezocht.
Wanneer een sleutel leeg is dan worden de waardes van de voorgaande sleutels gesplitst.

De tweede regel zijn jouw headers
Voor de sommige data staat in de cellen een ' want excel heeft een beetje moeite met de opmaak van je datum.

Private Sub CommandButton1_Click()
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            sFolder = .SelectedItems(1)
            Set rRange = Blad1.Cells(1, 1).CurrentRegion
            rRange.Offset(2, 0).ClearContents
            With CreateObject("Scripting.FileSystemObject")
                For Each oFile In .GetFolder(sFolder).Files
                    lRow = lRow + 1
                    aLine = Split(.OpenTextFile(oFile.Path).ReadAll, vbCrLf)
                    For Each oKey In rRange.Rows(1).Cells 'sleutels
                        sKey = oKey.Value
                        lKey = oKey.Column
                        If sKey <> vbNullString Then 'als een sleutel leeg is, dan worden de gegevens van de voorgaande sleutel gesplitst
                            vVal = Filter(aLine, sKey)
                            sVal = Trim(Mid(vVal(UBound(vVal)), Len(sKey) + 1)) 'pak de laatste regel met een sleutel en verwijder de sleutel die voor de gegevens staat
                            rRange.Cells(lRow + 2, lKey) = "'" & sVal
                        Else
                            sVal = WorksheetFunction.Trim(rRange.Cells(lRow + 2, oKey.Column - 1))
                            vVal = Split(sVal, " ")
                            rRange.Cells(lRow + 2, lKey - 1) = vVal(0)
                            rRange.Cells(lRow + 2, lKey) = vVal(1)
                        End If
                    Next
                Next
            End With
            rRange.Columns.AutoFit
            Set rRange = Nothing
        End If
    End With
End Sub

 

[JEC.]

Even je folderpad aanpassen. Zorg ervoor dat alleen die specifieke textfiles in 1 folder staan.

Sub jveerrr()
    Application.ScreenUpdating = False
    Sheets(1).Cells(1).CurrentRegion.Offset(1).ClearContents
    c00 = "C:\Users\...\...\..\..\..\"
  
    With CreateObject("scripting.filesystemobject")
        For Each fl In .getfolder(c00).Files
            ps = .opentextfile(c00 & fl.Name).readall
            ar = Split(Replace(Split(Join(Split(ps, vbLf)), "%")(1), "-", ""), " ")
            
            ReDim jv(UBound(ar))
            jv(j) = Application.Trim(Replace(Split(ps, vbLf)(1), "Start date", ""))
            jv(j + 1) = Application.Trim(Replace(Split(ps, vbLf)(2), "Start time", ""))
            jv(j + 2) = Application.Trim(Replace(Split(ps, vbLf)(3), "CSV duration", ""))
             
            For i = 0 To UBound(ar)
                If IsNumeric(ar(i)) Then jv(j + 3) = ar(i): j = j + 1
            Next
             
            Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, j + 2) = jv
            j = 0
        Next
      End With
End Sub

 

[snb]

Omdat het om onderzoek gaat lijkt het me verstandig na te denken wat je met de geïmporteerde gegevens verder wil.
Jouw opzet is dan niet voor de hand liggend.
Excel heeft ingebouwde analysemogelijkheden (bijv. draaitabel, grafiek).
Analysetools houden van genormaliseerde data (tabellen).
Als je de geïmporteerde gegevens meteen in een genormaliseerde tabel opslaat maak je het jezelf aanzienlijk gemakkelijker voor het vervolg.
De velden worden : datum; soort meting; waarde; relatieve waarde

Zet alle te importeren bestanden in een aparte directory.
In mijn code is dat directory G:\OF\Z_01
Dan gebruik ik de volgende code:

Sub M_snb()
  CreateObject("wscript.shell").Run "cmd /c copy G:\OF\Z_01\*.txt G:\totaal.txt"
    
  sn = Filter(Filter(Split(CreateObject("scripting.filesystemobject").opentextfile("G:\totaal.txt").readall, vbCrLf), ">>", 0), ".")
    
  ReDim sp(UBound(sn), 3)
  For j = 0 To UBound(sn)
    If Left(sn(j), 1) = "F" Then
      c00 = Mid(sn(j), 23, 10)
      n = n + 1
    Else
      st = Split(Application.Trim(sn(j)))
      sp(j - n, 0) = c00
      sp(j - n, 1) = st(0)
      sp(j - n, 2) = st(1)
      sp(j - n, 3) = st(2)
    End If
  Next
    
  Sheet1.Cells(1).Resize(UBound(sp), 4) = sp
End Sub

 

[JohnBoat]

De eerste regel bevatten de sleutels waarmee in de tekst bestanden wordt gezocht.
Wanneer een sleutel leeg is dan worden de waardes van de voorgaande sleutels gesplitst.

De tweede regel zijn jouw headers
Voor de sommige data staat in de cellen een ' want excel heeft een beetje moeite met de opmaak van je datum.

Private Sub CommandButton1_Click()
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            sFolder = .SelectedItems(1)
            Set rRange = Blad1.Cells(1, 1).CurrentRegion
            rRange.Offset(2, 0).ClearContents
            With CreateObject("Scripting.FileSystemObject")
                For Each oFile In .GetFolder(sFolder).Files
                    lRow = lRow + 1
                    aLine = Split(.OpenTextFile(oFile.Path).ReadAll, vbCrLf)
                    For Each oKey In rRange.Rows(1).Cells 'sleutels
                        sKey = oKey.Value
                        lKey = oKey.Column
                        If sKey <> vbNullString Then 'als een sleutel leeg is, dan worden de gegevens van de voorgaande sleutel gesplitst
                            vVal = Filter(aLine, sKey)
                            sVal = Trim(Mid(vVal(UBound(vVal)), Len(sKey) + 1)) 'pak de laatste regel met een sleutel en verwijder de sleutel die voor de gegevens staat
                            rRange.Cells(lRow + 2, lKey) = "'" & sVal
                        Else
                            sVal = WorksheetFunction.Trim(rRange.Cells(lRow + 2, oKey.Column - 1))
                            vVal = Split(sVal, " ")
                            rRange.Cells(lRow + 2, lKey - 1) = vVal(0)
                            rRange.Cells(lRow + 2, lKey) = vVal(1)
                        End If
                    Next
                Next
            End With
            rRange.Columns.AutoFit
            Set rRange = Nothing
        End If
    End With
End Sub

Beste AlphaMax en anderen,

Wow, dit is echt precies wat ik zocht! Hier ben ik heel erg blij! Ik heb alle suggesties geprobeerd en voor mij is het excel document van Alphamax precies wat ik zoek. Ook handig met zo'n knop. Heb het ook met andere tekstbestanden het geprobeerd: en het werkt echt perfect!
Ik hoef geen verdere analyses te doen met excel, ik moet enkel de data herstructureren zodat ik het in een online database kan verwerken. In combinatie met andere data wordt dit uiteindelijk in SPSS6 geanalyseerd. Hartelijk dank iedereen voor zijn/haar tijd en moeite!

@Alphamax, ik zou graag nog één extra kolom willen toevoegen (met een vaste tekst w1d1 - w5d7), voor mij is dan visueel makkelijker om data te herstructureren. Helaas doet de code dan niet meer. Ik heb een voorbeeld in de bijlage. Kan dat eventueel nog worden aangepast (wellicht heel gemakkelijk, maar mij is het niet gelukt).

Ook begrijp ik niet deze zin: ''Wanneer een sleutel leeg is dan worden de waardes van de voorgaande sleutels gesplitst''. Wat wordt hier precies mee bedoelt?

Nogmaals super veel dank iedereen!

 

[alphamax]

In E1 staat "back", deze haalt "Back 559 58.35" uit test1.txt en zet voorlopig "559 58.35" in de kolom onder "back".
In F1 staat niets/leeg, deze haalt "559 58.35" uit de kolom onder "back".
Deze word gesplitst in "559" en "58.35"
"559" komt onder de kolom onder "back" en "58.35" komt onder de kolom niets/leeg.
Op deze manier kan ik met een truukje "Back", "Right", "Left", "Up", "Belly" en "Vib" splitsen.

w1d1 - w5d7
Zijn dit blokken van 7 waarmee je later met SPSS6 de analyse kan doen?
of is het kort voor "week 1", "dag 1"?

 

[JohnBoat]

In E1 staat "back", deze haalt "Back 559 58.35" uit test1.txt en zet voorlopig "559 58.35" in de kolom onder "back".
In F1 staat niets/leeg, deze haalt "559 58.35" uit de kolom onder "back".
Deze word gesplitst in "559" en "58.35"
"559" komt onder de kolom onder "back" en "58.35" komt onder de kolom niets/leeg.
Op deze manier kan ik met een truukje "Back", "Right", "Left", "Up", "Belly" en "Vib" splitsen.

w1d1 - w5d7
Zijn dit blokken van 7 waarmee je later met SPSS6 de analyse kan doen?
of is het kort voor "week 1", "dag 1"?

Dank voor de uitleg!

Ja dat klopt, het zijn 5 weken. Na het inladen in dit excel bestand, controleer ik de volgorde en pas het eventueel aan. Daarna heb ik reeds al een andere code om de de gegevens achter elkaar te plakken in een ander excel bestand voor bulk import. De w1d2 etc is alleen even voor mij om te zien of het ingeladen document wel klopt bij de dag.

Handmatig kost dit 30 minuten per patiënt, nu maar 2 min. Echt fantastisch!

 

[alphamax]

Ik zal er morgen even naar kijken.

 

[snb]

Ik heb deze nog in de aanbieding:

Sub M_snb()
  If Dir("G:\totaal.txt") = "" Then CreateObject("wscript.shell").Run "cmd /c copy G:\OF\Z_01\*.txt G:\totaal.txt"
    
  sn = Split(Join(Filter(Split(Join(Filter(Filter(Split(Replace(CreateObject("scripting.filesystemobject").opentextfile("G:\totaal.txt").readall, "name", ""), vbCrLf), ">>", 0), "."), " ~")), "~", 0)), "C:\LEFT\")
  Sheet1.Cells(1).Resize(UBound(sn) + 1) = Application.Transpose(sn)
  Sheet1.Columns(1).TextToColumns , , , -1, 0, 0, 0, -1, 0, , , "."
End Sub

 

[alphamax]

Zie bijlage