VBAでtxtを読み込みxlsで保存したい

質問

C:\Documents and Settings\All Users\デスクトップ\sample.txt
は次のようなデータになっています。

A B C
1,234 567,890 23,333
1,234 567,890 23,333

このデータをVBAを使ってExcelに読み込み、C:\Documents and Settings\All Users\デスクトップ\sample.xls
として保存にしたいのですが、どのようなコードを書けばよいものでしょうか？

sub test()
Dim fso, f, ts
Dim sline As String
Set fso = CreateObject("scripting.filesystemobject")
Set f = fso.getfile("C:\Documents and Settings\All Users\デスクトップ\sample.txt")
Set ts = f.openastextstream(1)
Do While ts.atendofstream <> True
sline = sline & ts.readline & vbCrLf
Loop
ts.Close
' MsgBox sline
End Sub

ここまでいったのですが、slineをexcelにだすことができません。
教えていただけると助かります・。

回答No.4

mitarashi

#1です。もとのコードを熟読しておりませんでしたが、
Do While ts.atendofstream <> True
sline = sline & ts.readline & vbCrLf
Loop
ここのところで、1行ずつ読んだデータを、slineにまとめているのですね。
であれば、最初から
sline = ts.ReadAll
でループを回さずに、1行で済んでしまいます。
Do While ts.atendofstream <> True
で、1行ずつ読むのであれば、
sline = ts.readline
で取得した1行に対して、#1の処理でワークシートに書き込んでやれば良いです。
なお、
destRange.Offset(0, i) = ssline(i)
のところは、
destRange.Offset(0, i).value = ssline(i)
が正しいので注釈しておきます。（無くても動きますが）

参考URL：

http://officetanaka.net/excel/vba/filesystemobject/textstream.htm#ReadAll

回答No.3

argument

はじめまして　you_ko_02_08　さん
まずサンプルソースをそのままC&Pして実行したところこのデータはタブ区切りデータですね？これは大切なことです。
1番さんは半角スペース区切り時の対応を書いていますが私はタブ区切りデータをして書いています(でも安心してください下記ソースはタブをスペースに変えるだけで対応できるように書いています)、質問はできるだけ詳細に条件を説明するべきでしょう。
さて、まぁそれは置いて置きましょう其れは回答後に補足で回答後に再度回答すればいい程度の問題です(回答者が減る程度の問題なのですね)。

>ここまでいったのですが、slineをexcelにだすことができません。
とのことなので
今回の質問はタブ区切りテキストを解析しエクセルに出力する。
でよろしいですね？ある程度ソースが書けるようなんで保存まで処理を書きません。もし解らなければ再度質問してください。

Sub test()
'テキストのディレクトリを指定します。
myfile = "C:\Documents and Settings\All Users\デスクトップ\sample.txt"

'データを取得しつつ配列化します
textdata = Split(CreateObject("Scripting.FileSystemObject").OpenTextFile(myfile, 1).ReadAll(), vbCrLf)
ReDim mytext(UBound(textdata)): For i = 0 To UBound(textdata): mytext(i) = textdata(i): Next

'データを二次配列化します
For i = 0 To UBound(mytext): mytext(i) = Split(mytext(i), vbTab): Next

'データを書き込みます
For i = 0 To UBound(mytext)
For j = 0 To UBound(mytext(i))
Cells(i + 1, j + 1).Value = mytext(i)(j)
Next
Next
End Sub

さて、実行してみましたか？お望みの結果が出力されたと思います。
このデータはまず改行コードで配列化さらに其れをタブで配列化し、二次配列を生成しています。
基本配列格納は0からなのでforは0からですが書き込むセルは1から始まるので＋1指定します。
データを一気に読み込むのは開始位置を好きなように変更できる利点があるかです。ですがこれは大量データに向きません。
しかしながら事前の前提でそんな大量のデータを読み書きするとは書いていないのでこの回答で十分だと判断しました。

追加補足、処理違いなどがあればいってください。

回答No.2

hotosys

こんなのでは？
Sub test()
'テキスト読み込み
Dim fso As Object, ts As Object
Dim sline As String
Set fso = CreateObject("scripting.filesystemobject")
Set ts = fso.getfile("C:\Documents and Settings\All Users\デスクトップ\sample.txt").OpenAsTextStream
sline = ts.ReadAll
ts.Close
MsgBox sline
'新規のExcelBookを作ってそこにデータを書き込む
Dim wb As Workbook
Dim rowData() As String
Dim colData() As String
Dim r As Integer
Dim c As Integer
Set wb = Workbooks.Add
rowData() = Split(sline, vbCrLf) 'crlfで分ける
For r = 0 To UBound(rowData)
rowData(r) = Replace(rowData(r), ",", "") 'カンマを消す場合
colData = Split(rowData(r), " ") '半角空白で分ける
If UBound(colData) >= 0 Then '改行のみに対処
For c = 0 To UBound(colData)
Cells(r + 1, c + 1) = colData(c)
Cells(r + 1, c + 1).NumberFormat = "#,##0" '3桁カンマを書式として付ける場合
Next
End If
Next
wb.Close SaveChanges:=True, Filename:="C:\Documents and Settings\All Users\デスクトップ\sample.xls" '同名のファイルがある場合は上書き保存
End Sub

p.s.
For c = 0 To UBound(colData)
Cells(r + 1, c + 1) = colData(c)
Next
の部分は
Cells(r + 1, 1).Resize(1, UBound(colData) + 1) = colData
で、1列分まとめて設定だけど文字型になってしまった。

回答No.1

mitarashi

読み込んだ1行が、半角スペース区切りの時、さわりを記します。
最後のSet destRange = destRange.Offset(1, 0)は、頭を使わず、エクセルの行を1行下に進めるコードです。
ご参考まで。
Sub test()
Dim sline As String
Dim ssline As Variant
Dim destRange As Range
Dim i As Long
Const delimiterChar As String = " "

sline = "1,234 567,890 23,333"
Set destRange = Range("a1")
ssline = Split(sline, delimiterChar)
For i = LBound(ssline) To UBound(ssline)
destRange.Offset(0, i) = ssline(i)
Next i
'エクセルの次の行に進めたければ
Set destRange = destRange.Offset(1, 0)
End Sub