大量のワードのファイルをテキスト保存する仕事が入り、フォルダ内にあるワードファイルをテキスト保存し、テキストボックスやオートシェープの中のテキストも抜き出すプログラムを「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
よろしく、お願いします。
http://okwave.jp/qa/q2568740.html
上記と同じ質問です。
例えば、「あああ.xlsx」で作業していて、一旦別のファイル名、
例えば「いいい.xlsx」として保存した後に、ファイル「あああ」に戻りたい時があります。
ところが、「いいい」で保存してしまうと、
開いているファイルが「いいい」になってしまうため、
「あああ」に戻るには、「いいい」を閉じてから「あああ」を再度開かなければならず、
とても煩わしいです。これをVBAで解決する方法はありますでしょうか。
以下コードを作成しましたが、当然というか、自分では上の問題を解決できませんでした。
（ただ普通に保存しただけ・・）
解決方法について、どなたかご教示頂ければ幸いです。
Sub ファイル保存()
Dim myFile As String
Dim Syori As VbMsgBoxResult
myFile = ActiveSheet.Range("A1").Value & ".xlsm"
Syori = MsgBox("指定した名前のファイル名で保存します。" & vbCrLf & "よろしいですか？", vbYesNo, Title:="確認")
If Syori = vbYes Then
ThisWorkbook.SaveAs fileName:=myFile
MsgBox "保存しました。"
Else
MsgBox "中止しました。"
End If
End Sub
なお、使用環境はexcel2007です。
よろしくお願いいたします。
