[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『マクロでワードパッドファイルの内容を取得するには？』（カシスソーダ）
おはようございます。よろしくお願いいたします。
Windows XP SP3 Excel 2002 です。
指定のワードパッド内容を取得したいのですが方法がわかりません。 メモ帳(txt)の内容の取得方法はわかるのですが、そのままワードパッドに転用できませんでした。
メモ帳の内容取得は下記のコードでいけました。
Sub test() Dim mypath As String Dim mystr As String mypath = "C:\test\aaa.txt" mystr = naiyouget(mypath) MsgBox mypath End Sub
Function naiyouget(ByVal mypath As String)
Dim FSO As Object
Dim f As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.getfile(mypath).Size = 0 Then
naiyouget = ""
Else
Set f = FSO.OpenTextFile(mypath)
naiyouget = f.ReadAll
End If
Set FSO = Nothing
End Function
これをワードパッド(拡張子 rtf)で試してみたら、
(1) ------------ 1行目の文字列 2行目の文字列 3行目の文字列 ------------ という内容のファイルの内容を取得したら
(2)
------------
{\rtf1\ansi\ansicpg932\deff0\deflang1033\deflangfe1041{\fonttbl{\f0\froman\fprq1\fcharset128 \'82\'6c\'82\'72 \'82\'6f\'83\'53\'83\'56\'83\'62\'83\'4e;}}
{\*\generator Msftedit 5.41.15.1515;}\viewkind4\uc1\pard\lang1041\f0\fs20 1行目の文字列\par
2行目の文字列\par
3行目の文字列\par
}
------------
というような感じになってしまいました。 たしかにワードパッドファイルをメモ帳上にドラッグ＆ドロップしたら (2)の内容でした。 ワードパッドをWクリックで開いたらもちろん(1)が表示されます。
エクセルでワードパッドの内容を取得するにはどのようにコーディングすればいいでしょうか？ ご教示お願いいたします。
ワードパッドで開いて、書式なしのテキストで保存しなおした方が １番簡単なような気がしますけど。 BJ
Wordと互換性がありそう（PCにワードパットがないので）なので、 Wordで開いてみては？ いかがですか！！
開ければ、Createobject("Word.Application") で
Documentオブジェクトとして、内容を取得できそうですけどね！！
ichinose
BJさん、ichinoseさん、ご回答ありがとうございます。
ワードドキュメントとして開くことでうまく行きました。
'ワードパッドファイル内容を一行づつ取得
Sub rtfgetA()
Dim wd As Object
Dim dc As Object
Dim dcpath As String
Dim dcstr As String
Dim dclinestr As String
Dim i As Integer
dcpath = "C:\test\aaa.rtf"
Set wd = CreateObject("Word.Application")
Set dc = wd.documents.Open(dcpath)
dcstr = ""
For i = 1 To dc.Range.Paragraphs.Count
dclinestr = dc.Range.Paragraphs(i).Range
dclinestr = Replace(dclinestr, "", vbCrLf)
dclinestr = Left(dclinestr, Len(dclinestr) - 1)
If dcstr <> "" Then dcstr = dcstr & vbCrLf
dcstr = dcstr & dclinestr
Next i
MsgBox dcstr
dc.Close
wd.Quit
Set dc = Nothing
Set wd = Nothing
End Sub
'ワードパッドファイル内容を一括取得/クリップボードに一旦格納しエクセルのコントロールツールボックスのテキストボックス使用しクリップボード内容取得
Sub rtfgetB()
Dim wd As Object
Dim dc As Object
Dim dcpath As String
Dim dcstr As String
Dim mytb As OLEObject
Dim ws As Worksheet
dcpath = "C:\test\aaa.rtf"
Set wd = CreateObject("Word.Application")
Set dc = wd.documents.Open(dcpath)
dcstr = ""
wd.Selection.WholeStory
wd.Selection.Copy
Set ws = ActiveSheet
Set mytb = ws.OLEObjects.Add(ClassType:="Forms.TextBox.1", Link:=False, _
DisplayAsIcon:=False, Left:=0, Top:=0, Width:=1, Height:=1)
With ws.OLEObjects(mytb.Name).Object
.MultiLine = True
.Paste
dcstr = .Value
End With
MsgBox dcstr
mytb.Delete
Set mytb = Nothing
Set ws = Nothing
dc.Close
wd.Quit
Set dc = Nothing
Set wd = Nothing
End Sub
'ワードパッドファイル内容を一括取得/クリップボードに一旦格納しクリップボード内容直接取得
'参照設定：Microsoft Forms 2.0 Object Library
Sub rtfgetC()
Dim wd As Object
Dim dc As Object
Dim dcpath As String
Dim dcstr As String
Dim ND As New DataObject
dcpath = "C:\test\aaa.rtf"
Set wd = CreateObject("Word.Application")
Set dc = wd.documents.Open(dcpath)
dcstr = ""
wd.Selection.WholeStory
wd.Selection.Copy
With ND
.GetFromClipboard
dcstr = .GetText
End With
MsgBox dcstr
dc.Close
wd.Quit
Set dc = Nothing
Set wd = Nothing
End Sub
おかげさまで解決しました。 ご回答ありがとうございました。
(カシスソーダ)
カシスソーダさんの申し分ない質問投稿、返信投稿に感心しました。
参考程度に以下のコードです。
Sub test()
Dim g0 As Long
Dim myarray As Variant
myarray = get_wtxt(ThisWorkbook.path & "\xxxx.rtf")
'実際のパス
If TypeName(myarray) <> "Boolean" Then
myarray = Split(myarray, Chr(13))
For g0 = LBound(myarray) To UBound(myarray)
Cells(g0 + 1, 1).Value = "'" & myarray(g0)
Next
Erase myarray
Else
MsgBox "エラー発生"
End If
End Sub
Function get_wtxt(ByVal path As Variant) As Variant
'機能 Wordで開いたファイルのテキストを取得する
'input path 取得したいテキストがあるファイルのフルパス
'out get_wtxt 取得したテキスト False--何らかのエラー発生
On Error Resume Next
With CreateObject("word.application")
.Visible = False
With .Documents.Open(path)
If Err.Number = 0 Then
get_wtxt = .Range.Text
Else
get_wtxt = False
End If
.Close False
End With
.Quit
End With
On Error GoTo 0
End Function
ichinose
ichinoseさん、再度のご教示ありがとうございます。
ご教示いただきましたコードでうまく行きました。 最初エラーになったので何故？と思ったら新規ブックで実行してました。 ブックを一度保存してから実行したらうまく行きました。
また、あまり意味ないかもしれませんが変わりませんが、コードを下のよう に書き換えてもうまく行きました。
> myarray = get_wtxt(ThisWorkbook.path & "\www.rtf") > '実際のパス
↓
myarray = get_wtxt(ThisWorkbook.path & "\www.rtf")
'実際のパス
myarray = "'" & Replace(myarray, Chr(13), Chr(13) & "'")
> Cells(g0 + 1, 1).Value = "'" & myarray(g0)
↓
Cells(g0 + 1, 1).Value = myarray(g0)
ありがとうございました。 (カシスソーダ)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.