< návrat zpět

MS Excel

Téma: načtení z TXT od řádku rss

Zaslal/a paveku 12.5.2010 19:36

Dobrý den, prosím o radu. Potřebuji pomocí VBS načíst z TXT souboru řádky do proměnné, ale první 4 vynechat. Další řádky v souboru jsou v 7 sloupcích oddělených mezerami různých délek. Potřebuji načíst pouze 3 a 4 sloupec a tyto uložit do jiného souboru a zde je oddělit ",". Snad je to srozumitelné. Díky

Zaslat odpověď >
Jeza.m(13.5.2010 18:29)#001658
Jeza.m
Ahoj,

pro načítání v preferencích projektu používám Microsoft Scripting Runtime knihovnu - stačí zaškrtnout.

Pak by kód mohl vypadat nějak takto:
Sub nacti()
Dim fso As New FileSystemObject
Dim fil As File
Dim ts As TextStream
Dim text() As String
Dim radek As Single

radek = 1

Set fil = fso.GetFile(ThisWorkbook.Path & "\soubor.txt")
Set ts = fil.OpenAsTextStream(ForReading)

For i = 1 To 4
ts.SkipLine
Next

Do While ts.AtEndOfStream = False
text = Split(ts.ReadLine, " ")
Cells(radek, 1) = text(3)
Cells(radek, 2) = text(4)
radek = radek + 1
Loop

End Sub
ale trochu mě mate těch 7 sloupců oddělených mezerami různých délek - asi by bylo dobré ten texťák vidět.

M@citovat
paveku(13.5.2010 19:29)#001661
avatar
Ahoj, posílám vzor, jak vypadá vstupní soubor. Potřebuji načíst 3 a 4 sloupec a zapsat je do nového souboru a oddělit čárkou.

Mám ještě jednu otázku. Testuji existenci souboru pomocí

If Dir(Vstup) = "" Then
MsgBox "Vstupní soubor " & soubor & _
" nebo cesta na něj neexistuje ! "
Exit Sub

Pokud cesta obsahuje dvě zpětná lomítka, např.C:\test\\soubor.txt tak to vyhodnotí tak, že pokračuje na End IF.
Příloha: txt1661_vzor.txt (2kB, staženo 41x)
citovat
Jeza.m(13.5.2010 21:01)#001663
Jeza.m
No jo, koukám, že to bere třeba i deset zpětných lomítek za sebou :-), tak nezbývá než to zkontrolovat :-)
Dim cesta As String
cesta = "C:\\Bowling.php"
If Dir(cesta) = "" Or InStr(1, cesta, "\\", vbTextCompare) <> 0 Then
MsgBox "NE"
Else
MsgBox "JO"
End If

To načítání bych řešil počtem znaků a odstraněním mezer - příklad v příloze.
Jinak kód tady:
Dim fso As New FileSystemObject
Dim fso2 As New FileSystemObject
Dim fil As File
Dim fil2 As File
Dim ts As TextStream
Dim ts2 As TextStream
Dim text As String
Dim sl3 As String
Dim sl4 As String

radek = 1

Set fil = fso.GetFile(ThisWorkbook.Path & "\soubor.txt")
Set fil2 = fso2.GetFile(ThisWorkbook.Path & "\soubor2.txt")
Set ts = fil.OpenAsTextStream(ForReading)
Set ts2 = fil2.OpenAsTextStream(ForWriting)

For i = 1 To 4
ts.SkipLine
Next

Do While ts.AtEndOfStream = False
text = ts.ReadLine
sl3 = Replace(Mid(text, 17, 10), " ", "")
sl4 = Replace(Mid(text, 27, 10), " ", "")
If sl3 <> "" Or sl4 <> "" Then
ts2.WriteLine sl3 & "," & sl4
End If
Loop

ts.Close
ts2.Close

S pozdravem
M@
Příloha: zip1663_nacteni.zip (10kB, staženo 41x)
citovat

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Helios iNuvio

Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.

On-line nástroje