Word (VBA)

Word VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 7全般 : Word 2016)
webページ(フィルタ後)で別名保存
投稿日時: 17/01/16 22:18:57
投稿者: moyasin

よろしくお願いいたします。
 
ワードの文章を作成後、その文章をコピーして書式の設定が出来る掲示板(HTMLタグの入れられるやつです)に貼り付けると元の文章とは違うガタガタの書式になってしまいます。
 
調べた限りではワード文書で作成されたhtmlにはマイクロソフト独自のタグが入っているので書式が崩れてしまうっぽいです。
 
貼り付け後、掲示板でその手直しをする時間を取られるのがわずらわしいのでマクロを作っています。
 
手順として、
元のワードファイルをwebページ(フィルタ後)に別名保存する。
別名保存したファイルをsendkeysでメモ帳を起動して開き、全選択→HTMLソースをクリップボードにコピーする。
 
ここまではできました。後は掲示板に貼り付けるだけです。
 
ただ、別名保存したhtmlファイルを削除したいと思っていますがどうしても出来ません。KillやFSO.DeleteFileなどをためしたのですが・・・
メッセージボックスの上辺りにファイル削除処理を付けたいと思っています。
どうかお知恵を頂けたらと思います。(勿論、上記プロセスよりも良い方法をご存知でしたらそちらもお教えいただけたらと思います)
 
ソースはこちら
 
===============
 
Sub html()
 
Application.EnableCancelKey = xlDisabled
 
Dim Adoc As Word.Document
Set Adoc = ActiveDocument
 
Dim Path As String
Dim WSH As Variant
 
Dim fullpath As String
 
Set WSH = CreateObject("WScript.Shell")
Path = WSH.specialfolders("Desktop") & "\"
 
Adoc.SaveAs2 FileName:=Path & "test", _
FileFormat:=wdFormatFilteredHTML
 
fullpath = Path & "test.htm"
 
OpenMemo (fullpath)
 
'このあたりにファイルの削除処理
 
MsgBox "OK!"
 
End Sub
 
 
Function OpenMemo(OpenPath As String)
 
Shell "notepad.exe", 1
SendKeys "^o", True
SendKeys OpenPath, True
SendKeys "{ENTER}", True
SendKeys "{ESC}", True
SendKeys "^a", True
SendKeys "^c", True
SendKeys "%{F4}", True
 
End Function
 
================
 
一応エクセルのVBAは少しだけ経験がありますが、ワードは初めてでかつウェブには情報が少なく困っています。そもそもこのメモ帳のコマンドも上手く受け取れているのかも微妙ですが・・・
 
よろしくお願いいたします。

回答
投稿日時: 17/01/17 11:48:19
投稿者: kuni0416

こんにちは。
Excel VBAですが、ワード文書を開いて、HLML保存したものからBody内のタグのみ取得するものです。
HTML保存したHTMLファイルはKILLで削除しています。

Option Explicit
'参照設定
'Microsoft Word x.xx Object Library
'Microsoft HTML Object Library
'Microsoft Forms 2.0 Object Library
Sub test()
  Dim dc As Word.document
  Dim ReadData, TempFileName, WordFileName
  Dim CB As New DataObject
  WordFileName = Application.GetOpenFilename("Microsoft wORD 文書,*.DOCX")
  If WordFileName = False Then Exit Sub
  With CreateObject("word.application")
    .Visible = True
    Set dc = .Documents.Open(WordFileName)
    dc.SaveAs Filename:=ThisWorkbook.Path & "\temp文書.html", FileFormat:=wdFormatHTML
    dc.Close
    .Quit
  End With
  ReadData = WebDatGetProc(ThisWorkbook.Path & "\temp文書.html")
  Kill ThisWorkbook.Path & "\temp文書.html"
  With CB
    .SetText ReadData
    .PutInClipboard
  End With
End Sub
Public Function WebDatGetProc(ByVal url)
  Dim html As MSHTML.HTMLDocument
  Dim ReadData, wdate
  Dim DispMsg, retmsg
  Set html = New MSHTML.HTMLDocument
  Dim document As MSHTML.HTMLDocument
  Set html = New MSHTML.HTMLDocument
  Set document = html.createDocumentFromUrl(url, vbNullString)
  ' ダウンロード待ち
  Do While document.readyState <> "complete"
    DoEvents: DoEvents: DoEvents
  Loop
  'HTML取得(body内のみ)
  ReadData = document.body.innerHTML
  Set html = Nothing
  Set document = Nothing
  WebDatGetProc = ReadData
End Function

投稿日時: 17/02/21 22:41:59
投稿者: moyasin

kuni0416様
 
誠にありがとうございます。
返信が大変遅くなり申し訳ありませんでした!
 
ご助言のおかげで、うまく動きました!
 
Microsoft Word x.xx Object Libraryの部分が何だろう…?と思って調べたら、こんな便利な機能があったんですね。
ファイルをKillすることもできました。
 
WordのVBAは情報がなかなか見つからないので、書き込んでよかったです。
ありがとうございました!

回答
投稿日時: 17/02/27 15:26:06
投稿者: kuni0416

こんにちは。
上手くいって良かったです。
解決済みでしたら、閉じていただいた方が良いかと思います。

投稿日時: 17/02/28 11:22:23
投稿者: moyasin

kuni0416様
たびたび失礼致しました!
 
解決済みにいたしますね。
ありがとうございました!