VBA import y textoveho souboru

[Vevi]

Ahoj, potrebovala bych, prosim, pomoct s importem dat z textoveho souboru do excelu.

Textovych souboru je nekolik. Vsechny maji podobny nazev: "xxxxxx_global_set", tzn. xxxxxx je nejake sesticisli. Jsou ulozeny v jedne slozce. Potrebuju je pomoci makra naimportovat do sesitu (klidne i do nekolika listu). Obsah textaku ma stejnou hlavicku a ve vsech je oddelovacem dvojtecka.

Problem je v tom, ze pocet tech souboru se meni a ja potrebuju, aby se vzdy po spusteni makra naimporotovaly postupne vsechny. Rucne to sice jde taky, ale je to zdlouhave.

Diky moc

[Uziv00]

Netuším jak moc se liší VBA a VBS, ale pokud VBA umí příkazy, pak by stačilo načíst kolekci souborů v daném adresáři a do smyčky posílat jeden soubor za druhým.

Kód: Vybrat vše

Const path = "e:\adresar" 'cesta k adresáři 
Dim Obsah, i
Dim fso, oFolder, oFiles, wsh           
Obsah = ""
Set wsh = WScript.CreateObject("WScript.Shell")
' Create FileSystemObject object to access the file system.
Set fso = CreateObject("Scripting.FileSystemObject")
' Get Folder object.
Set oFolder = fso.GetFolder(wsh.ExpandEnvironmentStrings(path))  
Set oFiles = oFolder.Files         ' Get Files collection.
For Each i In oFiles           ' All files
    Obsah = i.Name
    ' sem vložit makro pro jeden soubor - jméno souboru je v proměnné Obsah
Next

Popřípadě by se to muselo celé napsat ve VBS, pak by xls soubor vytvořil VBS.

[Poki]

ITccrowduv kod jsem trochu upravil a doplnil.

- Musi se doplnit/upravit cesta k souboru hned v prvnim radku kodu
- Textove soubory museji mit opravdu oddelene vodorovne zaznamy dvojtecko (dalsi radky klasicky odrakovanim), jinak jsem to zkousel na svym testovacim vzrocku a fungovalo to..

Kód: Vybrat vše

Sub texty()
Const PATH = "c:\Documents and Settings\XXXX\Plocha\Download\_Text\" 'cesta k adresáři

Dim SOUBOR As String
Dim i As Variant
Dim FSO As New filesystemobject
Dim oFolder As Folder
Dim oFiles As Files

Set FSO = CreateObject("Scripting.FileSystemObject")

Set oFolder = FSO.GetFolder(PATH)
Set oFiles = oFolder.Files

For Each i In oFiles
    SOUBOR = i.Name

  Worksheets.Add After:=Sheets(Sheets.Count)
  ActiveSheet.Name = SOUBOR
    
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & PATH & SOUBOR, Destination:=Range("$A$1"))
        .Name = SOUBOR
        .FieldNames = True
        .PreserveFormatting = True
        .RefreshStyle = xlInsertDeleteCells
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePlatform = 1250
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileOtherDelimiter = ":"
        .TextFileColumnDataTypes = Array(2, 1, 2, 1) 'obecny format = 1, text format = 2
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
Next

[snowy01]

Ahoj
mám podobný problém. Potřeboval bych importovat proměnný počet .txt souborů obsahujících přibližně 25 řádků v tomto formátu

2016-01-08 20:16:37;1;173;2016-01-08 20:19:12;11,10,11,;0;2016-01-08 20:19:12;2016-01-08 20:21:51;2016-01-08 20:22:50

ideálně na jeden list pod sebe. Snažil jsem se upravit přiložený kód ale vždycky mi to hodí bug.
Díky moc