27. november 2008 - 12:51Der er
8 kommentarer og 1 løsning
Hvordan importeres flere text-filer i excel
Jeg har behov for at importere flere .txt-filer til excel. Jeg har ingen problemer med at importere dem enkeltvis, men da der er mange filer (+150) leder jeg efter hjælp til hvordan jeg kan autimatisere denne import, gerne vha VBA. Nogen forslag? De har ikke samme struktur, men er alle tabulator separeret.
Public Sub Hent_filer() Dim FileFind() As Variant, X As Integer, MyPath As String, MyName As String, Res As Variant Dim I As Long, Fil As String, Linje As String X = 0 MyPath = "c:\Data\" 'Ret til din sti. MyName = Dir(MyPath & "*.txt", vbDirectory) ' Retrieve the first entry. ReDim FileFind(X) FileFind(X) = MyName Do While MyName <> "" ' Start the loop. X = X + 1 ReDim Preserve FileFind(X) ' Ignore the current directory and the encompassing directory. If MyName <> "." And MyName <> ".." Then ' Use bitwise comparison to make sure MyName is a directory. End If MyName = Dir ' Get next entry. FileFind(X) = MyName Loop
Open MyPath & FileFind(X) For Input As #1 I = 1 Do Until EOF(1) Line Input #1, Linje If Linje <> "" Then Res = Split(Linje, vbTab) Range(Cells(I, 1), Cells(I, UBound(Res) + 1)) = Res I = I + 1 End If Loop Close 1 Next End Sub
Public Sub Hent_filer() Dim FileFind() As Variant, X As Integer, MyPath As String, MyName As String, Res As Variant Dim I As Long, Fil As String, Linje As String X = 0 MyPath = "c:\Data\" 'Ret til din sti. MyName = Dir(MyPath & "*.txt", vbDirectory) ' Retrieve the first entry. ReDim FileFind(X) FileFind(X) = MyName Do While MyName <> "" ' Start the loop. X = X + 1 ReDim Preserve FileFind(X) ' Ignore the current directory and the encompassing directory. If MyName <> "." And MyName <> ".." Then ' Use bitwise comparison to make sure MyName is a directory. End If MyName = Dir ' Get next entry. FileFind(X) = MyName Loop
Open MyPath & FileFind(X) For Input As #1 I = 1 Do Until EOF(1) Line Input #1, Linje Linje = Replace(Linje, ",", ".") ' erstatter komma med punktum If Linje <> "" Then Res = Split(Linje, vbTab) Range(Cells(I, 1), Cells(I, UBound(Res) + 1)) = Res I = I + 1 End If Loop Close 1 Next End Sub
Desværre er tilgangen ikke den bedste. I det tilfælde at jeg har tekst med komma, vil den også erstatte dette, ligesom tal med formatet 4.199,99 vil blive til 4.199.99 som igen vil give en fejl... Mon der er en metode til at sikre at indholdet ikke ændres?
Ok - men det hjælper ikke på tekstindhold mv. Jeg har ikke kontrol over importens data, dvs. det kan være tekst eller tal. Jeg prøver at se på hvor står konsekvens det har. Indtil da: Takker for din hjælp (igen)
Prøv at teste denne, den skriver kun i A kolonnen, derefter bruger den Excels indbyggede, Tekst til kolonner.
Public Sub Hent_filer() Dim FileFind() As Variant, X As Integer, MyPath As String, MyName As String, Res As Variant Dim I As Long, Fil As String, Linje As String X = 0 MyPath = "c:\Data\" 'Ret til din sti. MyName = Dir(MyPath & "*.txt", vbDirectory) ' Retrieve the first entry. ReDim FileFind(X) FileFind(X) = MyName Do While MyName <> "" ' Start the loop. X = X + 1 ReDim Preserve FileFind(X) ' Ignore the current directory and the encompassing directory. If MyName <> "." And MyName <> ".." Then ' Use bitwise comparison to make sure MyName is a directory. End If MyName = Dir ' Get next entry. FileFind(X) = MyName Loop
Måske det ligger i eksporten af data. Bruger denne kode:
Application.ScreenUpdating = False Application.DisplayAlerts = False For Each ws In ThisWorkbook.Worksheets
Sheets(ws.Name).Select Sheets(ws.Name).Copy ActiveWorkbook.SaveAs Filename:= _ sBuffer & "\" & ws.Name & "", _ FileFormat:=xlText, CreateBackup:=False ActiveWorkbook.Close ThisWorkbook.Activate Columns(LastColumn).Delete /bruges til at slette sidste kolonne. Next
Jeg kan se at din kode virker fint, men desværre er mit output stadig ikke korrekt. Mener at fejlen ligger i at det køres som en Macro. Hvis jeg manuelt gemmer som txt er der ikke nogen forskel - men hvis jeg inspiller samme arbejdsgang som Macro og derefter kører den, så ændre alle kommaerne til punktum!
Synes godt om
Ny brugerNybegynder
Din løsning...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.