• 締切済み

フォルダ内の複数のファイルで置換したい

お世話になります。 現在、フォルダ内にWord及びExcelファイルがたくさんありまして、 その中の”2009-11-30”という語を”2009-12-22”に 一括で置換したいと思っています。 置換したい語は、Wordではヘッダに、Excelではフッタにあります。 ネットで検索したらスクリプトという物があることを知り、また、 以下のようなword用のスクリプトを見つけたので、 置換する用語の部分だけ変更したのですが、 ヘッダに書いてある文字は置換してくれませんでした。 (ヘッダ以外の文字で試したらOKでした) これは、アイコンをダブルクリックして 対象のファイルが入っているフォルダを指定するものらしいです。 ------------------------------- '#1 フォルダ全部のファイルでやる場合 '#2 指定したファイルだけやる場合 Const wdReplaceAll = 2 strDir = InputBox("ディレクトリ名を入力してください。") '#1 Set objFSO = WScript.CreateObject("Scripting.FileSystemObject") '#1 Set objFolder = objFSO.GetFolder(strDir) '#1 Set objWord = CreateObject("Word.Application") objWord.Visible = True For Each objFile In objFolder.Files '#1 If Lcase(Right(objFile.Name, 4)) = ".doc" Then '#1 strArg = objFile.Path '#1 '#2 For Each strArg In WScript.Arguments Set objDoc = objWord.Documents.Open(strArg) Set objSelection = objWord.Selection objSelection.Find.ClearFormatting objSelection.Find.Replacement.ClearFormatting With objSelection.Find .Text = "2009-11-30" .Replacement.Text = "2009-12-22" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchByte = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = False .MatchFuzzy = True End With objSelection.Find.Execute ,,,,,,,,,,wdReplaceAll 'Replace:=wdReplaceAll objDoc.Save objWord.Documents.Close Set objDoc = Nothing Set objSelection = Nothing End if '#1 Next objWord.Quit -------------------------------------- これは、内容をどう変えたらヘッダやフッタ部分も 置換してくれるようになりますか? また、Excel用にするには、このスクリプト内の "Word"を"Excel"に変えるだけで良いのでしょうか? 参考までに、OSはXPです。 足りない情報等ございましたらご指摘願います。 どうぞよろしくお願いいたします。

みんなの回答

  • watabe007
  • ベストアンサー率62% (476/760)
回答No.3

こんにちは >With ws.PageSetup >If .LeftFooter = "2009-11-30" Then .LeftFooter = "2009-12-22" >If .CenterFooter = "2009-11-30" Then .CenterFooter = "2009-12-22" >If .RightFooter = "2009-11-30" Then .RightFooter = "2009-12-22" >End With >エクセルはフッタの左側にあり、 >そこには他の文字も含まれています。 なのでフッター値を一旦、変数に取得して置換えれば良いでしょうね With ws.PageSetup myFooter = .LeftFooter myFooter = Replace(myFooter, "2009-11-30", "2009-12-22") .LeftFooter = myFooter End With ワードは Set objWord = CreateObject("Word.Application") Set objDoc = objWord.Documents.Open("G:\Test.doc") With objDoc.Sections(1).Headers(1) myHeader = .Range.Text myHeader = Replace(myHeader, "2009-11-30", "2009-12-22") .Range.Text = myHeader End With objDoc.Close True を参考に

  • AKARI0418
  • ベストアンサー率67% (112/166)
回答No.2

横槍失礼いたします。 こんな感じでしょうか、watabe007様のコードを流用させていただきました。 Dim objExcel Dim wb, ws Dim dirPath As String Dim strFilePath As String Set objExcel = CreateObject("Excel.Application") 'objExcel.Visible = True '処理中Excelを表示したいのなら先頭の' を消してください。 With Application.FileDialog(msoFileDialogFolderPicker) If .Show = True Then dirPath = .SelectedItems(1) & "\" Else Exit Sub End If End With ' 先頭のファイル名の取得 strFilePath = Dir(dirPath & "*.xls", vbNormal) ' ファイルが見つからなくなるまで繰り返す Do While strFilePath <> vbNullString Set wb = objExcel.Workbooks.Open(dirPath & strFilePath) For Each ws In wb.Worksheets With ws.PageSetup If .LeftFooter = "2009-11-30" Then .LeftFooter = "2009-12-22" If .CenterFooter = "2009-11-30" Then .CenterFooter = "2009-12-22" If .RightFooter = "2009-11-30" Then .RightFooter = "2009-12-22" End With Next wb.Close True 'Test.xls 変更を保存して閉じる ' 次のファイル名を取得 strFilePath = Dir() Loop objExcel.Quit 'Excelを終了 Set objExcel = Nothing MsgBox "処理しました。"

  • watabe007
  • ベストアンサー率62% (476/760)
回答No.1

Excelの単体ファイルC:\Test.xlsでフッターの置換をしました。 参考になれば Dim objExcel Dim wb, ws Set objExcel = CreateObject("Excel.Application") 'objExcel.Visible = True '処理中Excelを表示したいのなら先頭の' を消してください。 Set wb = objExcel.Workbooks.Open("C:\Test.xls") For Each ws in wb.WorkSheets With ws.PageSetup If .LeftFooter = "2009-11-30" Then .LeftFooter = "2009-12-22" If .CenterFooter = "2009-11-30" Then .CenterFooter = "2009-12-22" If .RightFooter = "2009-11-30" Then .RightFooter = "2009-12-22" End With Next wb.Close True 'Test.xls 変更を保存して閉じる objExcel.Quit 'Excelを終了 Set objExcel = Nothing MsgBox "処理しました。"

w_dragon
質問者

お礼

回答どうもありがとうございます! こちらを試してみたのですが、これは全てのファイル名を この中で指定しないといけないんですよね? ファイルが数十個ある場合は、どうすればよいのでしょうか?

w_dragon
質問者

補足

watabe007様の内容を見て気づきました。 補足です。 ワードはヘッダに変更箇所があります。 エクセルはフッタの左側にあり、 そこには他の文字も含まれています。

関連するQ&A

  • Word2007 文字変換マクロについて

    以下のvbsファイルがエラーなってしまいます。 どう直したらよいかご教授お願いします。(マクロ初心者) Const wdReplaceAll = 2 Set objWord = CreateObject("Word.Application") objWord.Visible = False Set fs = CreateObject("Scripting.FileSystemObject") Set objFolder = fs.GetFolder("D:\test") For Each objFile in objFolder.Files If Right(LCase(objFile.Name), 5) = ".docx" Then Set objDoc = objWord.Documents.Open(objFolder.Path & "\" & objFile.Name) Set objSelection = objWord.Selection ' objSelection.Find.Text = "A" ' objSelection.Find.Forward = True ' objSelection.Find.MatchWholeWord = True ' objSelection.Find.Replacement.Text = "B" '---------------------------------------------------------- Open "D:\test\2.csv" For Input As #1 While Not EOF(1) Line Input #1, a s = Split(a, ",") MsgBox s(0) & " " & s(1) Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find '---------------------------------------------------------- objSelection.Find.Text = s(0) objSelection.Find.Forward = True objSelection.Find.MatchWholeWord = True objSelection.Find.Replacement.Text = s(1) '---------------------------------------------------------- objSelection.Find.Wrap = wdFindContinue objSelection.Find.Format = False objSelection.Find.MatchCase = False objSelection.Find.MatchWholeWord = False objSelection.Find.MatchByte = False objSelection.Find.MatchAllWordForms = False objSelection.Find.MatchSoundsLike = False objSelection.Find.MatchWildcards = False objSelection.Find.MatchFuzzy = True End With Selection.Find.Execute Replace:=wdReplaceAll Wend Close #1 End Sub '---------------------------------------------------------- If objSelection.Find.Execute( ,,,,,,,,,,wdReplaceAll) Then objDoc.Save End If objDoc.Close End If Next objWord.Quit

  • MicrosoftWordのページ指定置換マクロ

    お世話になります。 MicrosoftWordの文章の中の『SYSTEMS』と単語を XXXXXXXに置換するマクロを作ってみましたが これですとWordの文章ファイルの 全てページの『SYSTEMS』とゆう単語を置換してしまいます。 Wordの文章ファイルの1ページ目だけの全ての『SYSTEMS』 とゆう単語を置換するマクロはどのようにすればよいでしょうか? Sub Macro2() ' ' Macro2 Macro ' ' Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "SYSTEMS" .Replacement.Text = "XXXXXXX" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchByte = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = False .MatchFuzzy = True End With Selection.Find.Execute Replace:=wdReplaceAll End Sub

  • Word2010特定の名前を置き換えるマクロ

    例えば、Wordの文章で「田中」とあるものを「山田」に変えたい場合は、置き換えの機能を使ってマクロの記録ができると思います。 しかし、こうするとテキストボックスやヘッダフッタに記載された文字は変更できないように思います。 どうすれば、これらの文字も含めて置換の対象とすることができるか教えてください。 Sub Macro() Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "山田" .Replacement.Text = "田中" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchByte = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = False .MatchFuzzy = True End With Selection.Find.Execute Replace:=wdReplaceAll End Sub

  • vbscriptでWordのヘッダーを変更

    vbscriptでWordのヘッダーを変更したく、下記のコーディングをしましたが、ヘッダーの変更ができません。 (本文に"1111"が記載されてしまいます。) どこが違うか教えて頂けませんでしょうか? vbscriptでWordをコーディングするのは初めてです。 よろしくお願いします。 Set objWord = CreateObject("Word.Application") Set objDoc = objWord.Documents.Open ("C:\test\test.doc") objDoc.ActiveWindow.ActivePane.View.SeekView=wdSeekCurrentPageHeader objWord.Selection.ParagraphFormat.Alignment=wdAlignParagraphRight objWord.Selection.Text="1111" objDoc.ActiveWindow.ActivePane.View.SeekView=wdSeekMainDocument objWord.ActiveDocument.PrintOut objWord.ActiveDocument.Close (True) objWord.Quit

  • macroコードを短縮できるでしょうか。

    下記のコードで、実行できます。大部分はマクロを記憶し、同じ処理を重ねただけのものです。 目的は、ワードで選択した文字列の中から数字を削除します。 ただし、下記のような場合は削除しません。 【請求項1】、項2、ないし3、いずれか1、【0019】、第3の、 この処理を行うために、差別化しました。 まず、数字を赤字で太字にしました。 次に、上記の、削除しては具合が悪い数字については、明朝で標準に戻すようにしてから、赤字で太字の数字を削除しました。 2000文字を超えるので、途中大幅にカットしました。 以下は、コードです。 ~~~~~~~~~~~~~~~~~~~~~~~~ Private Sub 符号削除() Selection.Find.ClearFormatting Selection.Find.Font.Bold = True Selection.Find.Replacement.ClearFormatting With Selection.Range.Find .ClearFormatting .Text = "第1" .Replacement.Text = "" .Replacement.Font.Color = 1 .Replacement.Font.Bold = False .Execute Replace:=wdReplaceAll End With Selection.Find.ClearFormatting Selection.Find.Font.Bold = True Selection.Find.Replacement.ClearFormatting With Selection.Range.Find .ClearFormatting .Text = "第2" .Replacement.Text = "" .Replacement.Font.Color = 1 .Replacement.Font.Bold = False .Execute Replace:=wdReplaceAll End With Selection.Find.ClearFormatting Selection.Find.Font.Bold = True Selection.Find.Replacement.ClearFormatting With Selection.Range.Find .ClearFormatting .Text = "又は2" .Replacement.Text = "" .Replacement.Font.Color = 1 .Replacement.Font.Bold = False .Execute Replace:=wdReplaceAll End With ↓以下、20まで繰り返し Selection.Find.ClearFormatting Selection.Find.Font.Bold = True Selection.Find.Replacement.ClearFormatting With Selection.Range.Find .ClearFormatting .Text = "乃至20" .Replacement.Text = "" .Replacement.Font.Color = 1 .Replacement.Font.Bold = False .Execute Replace:=wdReplaceAll End With Selection.Find.ClearFormatting Selection.Find.Font.Bold = True Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "1" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchByte = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = False .MatchFuzzy = False End With Selection.Find.Execute Replace:=wdReplaceAll ↓以下、9,0まで繰り返し Selection.Find.ClearFormatting Selection.Find.Font.Bold = True Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "9" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchByte = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = False .MatchFuzzy = False End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.ClearFormatting Selection.Find.Font.Bold = True Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "0" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchByte = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = False .MatchFuzzy = False End With Selection.Find.Execute Replace:=wdReplaceAll End Sub ~~同じ繰返しを短くする部分の正規表現の使い方やloopを指南していただけたら幸甚です。

  • Wordマクロ

    Wordでワイルドカードを使った置換マクロを作ったのですが、 「MatchWildcardsとMatchSoundsLike、MatchAllWordForms、MatchFuzzyは、同時にTrueに設定することはできません。」 というエラーが出てしまいます。 MatchSoundsLike、MatchAllWordForms、MatchFuzzyは、 ソースに書いてないしTrueにもしていません。 どこが悪いのでしょうか? 以下がソースファイルです、よろしくお願いいたします。 Sub substitute() ' Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "[!a-f]{1,}" .Replacement.Text = "@" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchByte = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True .MatchFuzzy = False End With Selection.Find.Execute Replace:=wdReplaceAll End Sub

  • VBscriptで「改行」と「"」を置換させる

    VBスクリプトを使ってファイルを置換したいと考えています。 以下のVBSファイルとコマンドを使って、置換することはできました。 が、置換対象が「改行」と「"」の場合、エラーとなって置換できません。 どうすればいいのでしょうか。 よろしくおねがいします。 ********コマンド******** (1)cscript replace.vbs "C:\test.txt" "Jim" "Jane" (2)cscript replace.vbs "C:\test.txt" ""_\n" "a_test" ********VBSファイル(replace.vbs)******** Const ForReading = 1 Const ForWriting = 2 strFileName = Wscript.Arguments(0) strOldText = Wscript.Arguments(1) strNewText = Wscript.Arguments(2) Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFile = objFSO.OpenTextFile(strFileName, ForReading) strText = objFile.ReadAll objFile.Close strNewText = Replace(strText, strOldText, strNewText) Set objFile = objFSO.OpenTextFile(strFileName, ForWriting) objFile.WriteLine strNewText objFile.Close (1)のコマンドを実行すると、 「Jim」は「Jane」に置換されますが、 (2)のコマンドを実行すると、エラーになり置換されません。 エラーメッセージ: 「Microsoft VBScript 実行時エラー: インデックスが有効範囲にありません。」 よろしくおねがいします。

  • マクロを教えてください。

    ワードでマクロがうまくいきません。 マクロの知識はほとんどないのですが、「マクロの記録」の機能を使い、ワードで試しています。 今回は、 「{}の括弧でかこまれた単語を探し出し、その単語を括弧ごと消去する」 というのをしたいのです。 例えば、 ------------------------------- あいうえお{事実}ということ ↓ あいうえおということ ------------------------------ にしたいのです。 自分は ---------------------------------------- -置換-で、「検索する文字列」に「{*}」 「置換後の文字列」になにも書かない で、「置換」をクリック -------------------- マクロの記録を選択した後、上のように作業しました。 そしてマクロの記録をとめました。 が、なにもおこりません。 (*はワイルドカードのつもりなのですが、間違っていますでしょうか。) なにか変な操作をしたのか、と五度くらい試したのですが、 やはり動きません。 中身は、↓のようでした。 -------------------- Sub Macro1() ' ' Macro1 Macro ' Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "{*}" .Replacement.Text = "" .Forward = True .Wrap = wdFindAsk .Format = False .MatchCase = False .MatchWholeWord = False .MatchByte = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = False .MatchFuzzy = True End With Selection.Find.Execute Replace:=wdReplaceAll End Sub -------------------- どうしてうまく動かないのでしょうか。 教えていただけるとありがたいです。よろしくお願いします。

  • ワードでマクロがうまくいきません。

    よろしくお願いします。 マクロの知識はほとんどないのですが、 「マクロの記録」の機能を使い、ワードで 「スペースを探し出し、そのスペースにアンダーラインを引く。」 ために、 -------------------- 編集ー置換ー 検索する文字列にスペースをタイプ、 置換後の文字列にスペースをタイプ、 オプションの書式で、フォント、下線、一重下線 すべて置換 -------------------- マクロの記録を選択した後、上のように作業しました。 そしてマクロの記録をとめました。 マクロの記録中の操作では、思い通りに置換されるのですが、 次にそのマクロを作動させると、なにもおこりません。 なにか変な操作をしたのか、と五度くらい試したのですが、 やはり動きません。 中身は、↓のようでした。 -------------------- Sub Macro2() ' Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = " " .Replacement.Text = " " .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchByte = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = False .MatchFuzzy = True End With Selection.Find.Execute Replace:=wdReplaceAll End Sub -------------------- どうしてうまく動かないのでしょうか。 教えていただけるとありがたいです。よろしくお願いします。

  • VBS ファイルマージ処理

    特定のDir内、複数ファイルのレコードを全てマージする為、 以下の処理を考えておりますが実現に至っておりません。 Fileがなくなるまで、ループ処理をさせる為、File名 の(1)から(2)へFile名の受け渡し方法が解かりません。 何方か有識者の方、ご教授頂けませんでしょうか もっと賢くマージが出来るので有りますならば、その方法 を教えて頂けませんでしょうか ※Dir内にFileはユニークなFile名にて、複数個作られます。 ※マージに必要なFileだけがDirには作られます。 ※マージするFileの順番は問いません。 (1)C:\temp\temp Dir内のFile名を取得 Set objFso = CreateObject("Scripting.FileSystemObject") Set objFolder = objFSO.GetFolder("C:\temp\temp") objFile = objFso.GetAbsolutepathname("temp_ini.txt") Set objOut = objFso.OpenTextFile(objFile, 2, False) For Each objFile In objFolder.Files objFilemei = objFile.Name objOut.Writeline objFilemei next ※File名の受け渡しがわからず、一旦Fileに書き出してます (2)Fileが無くなるまで、File内のレコードを全て読込み、マージファイルを作成(予定) objFile1 = objFso.GetAbsolutepathname("temp_temp.txt") Set objin = objFso.OpenTextFile("temp_ini.txt",1) Do Until objin.atendofstream = True linedata = objin.readline() loop 説明が悪くてすみませんが、よろしくお願い致します。