2016-12-21 12 views
-2

サブフォルダでファイル名を検索し、Excelファイルを開き、Wordにコピー/貼り付けしようとしています。私のコードが今のところ、毎回新しいWord文書を開く方法です。各Excelファイルのアイテムを同じWord文書に貼り付けるにはどうすればよいですか?再帰中にWordが複数のドキュメントを開くのを防ぐ方法は?

Sub Word(f) 
    Set objWord = CreateObject("Word.Application") 
    Set objDoc = objWord.Documents.Add("C:\Users\ntunstall\Desktop\test\Doc1.docx") 
    objWord.Visible = True 
    objDoc.PageSetup.Orientation = 1 
    objDoc.Paragraphs.Alignment = 1 

    Set objExcel = CreateObject("Excel.Application") 
    Set objWkb = objExcel.Workbooks.Open(f) 
    objExcel.Visible = False 

    objWkb.Sheets("PresRate").ChartObjects("Chart 1").CopyPicture 
    objWord.Selection.Paste 
    objWord.Selection.MoveRight 
    objWord.Selection.TypeParagraph 

    objWkb.Save 
    objWkb.Close 
End Sub 

Dim path: path = "C:\Users\ntunstall\Desktop\test" 
Dim fso: Set fso = CreateObject("Scripting.FileSystemObject") 
Call TraverseFolders(fso.GetFolder(path)) 

Sub TraverseFolders(fldr) 
    Dim f, sf 
    For Each f In fldr.Files 
    If InStr(f.Name, "OPS") > 0 Then 
     If InStr(f.Name, "xlsm") > 0 Then 
      Call Word(f) 
     End If 
    End If 
    Next 

    For Each sf In fldr.SubFolders 
    Call TraverseFolders(sf) 
    Next 
End Sub 

wScript.Quit 
objWord.Quit 
objExcel.Quit 

Set objDoc = Nothing 
Set objWkb = Nothing 

IはIN /サブのうちSub Word(f)の可動部を試みたが、中/ Sub TraverseFolders(fldr)のうちました。オブジェクトは有効範囲外になるか、プログラムは複数のワードドキュメントを開きます。

+0

開いているファイルを開く、または開いているファイルに接続する 'GetObject(Fname)'。 'GetObject(、" Word.Application ")は既に実行中のWordに接続するための'(もし存在しなければエラー)。 –

答えて

2

Wordを起動するコードを移動し、手順Wordからグローバルスコープに新しい文書を作成する必要があります。私はまた、Excelオブジェクトの作成をグローバルスコープに移動します。これは、インスタンスが1つだけ必要なためです。

Sub Word(f) 
    Set objWord = CreateObject("Word.Application") Set objDoc = objWord.Documents.Add("C:\Users\ntunstall\Desktop\test\Doc1.docx") objWord.Visible = True objDoc.PageSetup.Orientation = 1 objDoc.Paragraphs.Alignment = 1 Set objExcel = CreateObject("Excel.Application") 
    Set objWkb = objExcel.Workbooks.Open(f) 
    objExcel.Visible = False 

    objWkb.Sheets("PresRate").ChartObjects("Chart 1").CopyPicture 
    objWord.Selection.Paste 
    objWord.Selection.MoveRight 
    objWord.Selection.TypeParagraph 

    objWkb.Save 
    objWkb.Close 
End Sub 

Dim path: path = "C:\Users\ntunstall\Desktop\test" 
Dim fso: Set fso = CreateObject("Scripting.FileSystemObject") 
Call TraverseFolders(fso.GetFolder(path))

これに:この

変更

Sub Word(f) 
    Set objWkb = objExcel.Workbooks.Open(f) 

    objWkb.Sheets("PresRate").ChartObjects("Chart 1").CopyPicture 
    objWord.Selection.Paste 
    objWord.Selection.MoveRight 
    objWord.Selection.TypeParagraph 

    objWkb.Save 
    objWkb.Close 
End Sub 

Dim path: path = "C:\Users\ntunstall\Desktop\test" 
Dim fso: Set fso = CreateObject("Scripting.FileSystemObject") 

Set objWord = CreateObject("Word.Application") Set objDoc = objWord.Documents.Add("C:\Users\ntunstall\Desktop\test\Doc1.docx") objWord.Visible = True objDoc.PageSetup.Orientation = 1 objDoc.Paragraphs.Alignment = 1 Set objExcel = CreateObject("Excel.Application") objExcel.Visible = False 

Call TraverseFolders(fso.GetFolder(path))

はまた、これを変更します。これに

WScript.Quit 
objWord.Quit 
objExcel.Quit 

Set objDoc = Nothing 
Set objWkb = Nothing 

objExcel.Quit 

を呼び出すのはWScript.Quitが最初にWord のExcelインスタンスが実行されていることがわかっているため、Wordインスタンスを保持しておきたいときに、変数がスクリプトの終了時に自動的に消去されます。

+0

ありがとうございます!ソリューションを使用してOPを編集しました。 – Nathan

+0

@Nathanしないでください。回答は質問に含めるべきではありません。 –

関連する問題