VBScript ワードunicodeテキスト保存
大量のワードのファイルをテキスト保存する仕事が入り、フォルダ内にあるワードファイルをテキスト保存し、テキストボックスやオートシェープの中のテキストも抜き出すプログラムを「VBScript」で作りました。
テキスト保存する際、Unicode形式で保存しなければならず、調べると、「SaveAs …, 7」がUnicodeによるテキスト保存だと分かったのですが、実際にやってみると、拡張子が「.rtf」ファイルだけが、Unicodeによるテキスト保存され、「.doc」や「.docx」は、「シフトJIS」保存されてしまいました。
私、何か間違っているのでしょうか？
以下、一応、プログラムをコピーしておきます。
問題の部分は「行１３」です。
なお、ワードは「Word2010」です。
01 Option Explicit
02 Public a, b, c, d, e, f, g, h, t, u, v, w, x, y, z
03 Set w = CreateObject("Word.Application")
04 w.Application.DisplayAlerts = False
05 w.Visible = False
06 Set x = CreateObject("Scripting.FileSystemObject")
07 Set y = x.GetFolder(".")
08 For Each a In y.Files
09 b = LCase(x.GetExtensionName(a.Name))
10 If b = "doc" or b = "docx" or b = "rtf" Then
11 h = x.GetBaseName(a.Name)
12 Set z = w.Documents.Open(y & "\" & a.Name)
13 z.SaveAs y & "\" & h & ".txt", 7
14 z.Close
15 Set z = Nothing
16 End If
17 If b = "docx" Then
18 Set z = w.Documents.Open(y & "\" & a.Name)
19 z.SaveAs y & "\qkza934irs2801wuptc56ynv7bm.doc", 0
20 z.Close
21 Set z = Nothing
22 Set z = w.Documents.Open(y & "\qkza934irs2801wuptc56ynv7bm.doc")
23 Call o
24 z.Close
25 Set z = Nothing
26 x.DeleteFile(y & "\qkza934irs2801wuptc56ynv7bm.doc")
27 ElseIf b = "doc" or b = "rtf" Then
28 Set z = w.Documents.Open(y & "\" & a.Name)
29 Call o
30 z.Close
31 Set z = Nothing
32 End If
33 If f > "" Then
34 Set t = x.CreateTextFile(y & "\TB_" & h & ".txt", True, True)
35 t.Write f
36 t.Close
37 End If
38 Next
39 w.Quit
40 Set z = Nothing
41 Set y = Nothing
42 Set x = Nothing
43 Set w = Nothing
44 MsgBox("Finished!")
45 Sub o
46 f = ""
47 For Each c In w.ActiveDocument.Shapes
48 If c.Type = 1 or c.Type = 17 then
49 Set v = c.TextFrame
50 e = v.TextRange
51 f = f & e
52 Set d = Nothing
53 ElseIf c.Type = 6 Then
54 For Each g In c.GroupItems
55 Set u = g.TextFrame
56 e = u.TextRange
57 f = f & e
58 Set u = Nothing
59 Next
60 End if
61 Next
62 End Sub
よろしく、お願いします。
![その他([技術者向] コンピューター) イメージ](https://gazo.okwave.jp/okwave/spn/images/related_qa/c205_1_thumbnail_img_sm.png)
