以下のVBScriptで、「コピー元のExcelファイルの指定セルの文字列を、コピー先のExcelファイルにペーストする」という処理を実現しようと思っています。
テンプレートフォルダの中にペーストするExcelファイルを配置。
コピー元フォルダに配置されたExcelファイルの数の分複製される。
実行したところ、以下のようにコピーしたセルが画像のような形でペーストされており、意図した結果でないため困っています。
コピーの仕方が悪いのか、ペーストの仕方が悪いのか、
どなたか原因が分かる方がいらっしゃったらご教示願います。
vbs:testDataCopy.vbs
1Option Explicit 2 3' ====================================================================================== 4' 変数定義 5' 6' ====================================================================================== 7 8Dim objFSO ' FileSystemObject 9Dim baseFolder ' 作業フォルダパス 10Dim copyFolder ' コピー元フォルダパス 11Dim pasteFolder ' コピー先フォルダパス 12Dim copySheetName ' コピー元シート名 13Dim copyRange ' コピー元セル範囲 14 15Dim pasteSheetName ' コピー先シート名 16 17Dim templateFileName ' テンプレートファイル名 18Dim templateFolder ' テンプレートファイルが配置されたフォルダパス 19 20' ====================================================================================== 21' パラメータ設定(環境に合わせて定義すること) 22' 23' ====================================================================================== 24 25copySheetName = "フォーマット" ' コピー元シート名 26copyRange = "[B6:E6],[B9:D10],[G7:AJ106]" ' コピー元セル範囲(複数の範囲指定⇒(例)"[A1:A2],[B1,B2]") 27 28pasteSheetName = "フォーマット" ' コピー先シート名 29 30templateFileName = "template.xlsx" 31 32 33' ====================================================================================== 34' EXCELコピー&ペースト 35' 36' ====================================================================================== 37' フォルダパス設定 38Set objFSO = WScript.CreateObject("Scripting.FileSystemObject") 39If Err.Number = 0 Then 40 Dim currentDir 41 currentDir = objFSO.getParentFolderName(WScript.ScriptFullName) 42 copyFolder = currentDir & "\" & "コピー元" 43 pasteFolder = currentDir & "\" & "コピー先" 44 templateFolder = currentDir & "\" & "テンプレート" 45Else 46 WScript.Echo "エラーが発生したため終了します。" 47 WScript.Quit 48End If 49 50' コピー元セル範囲をリスト化 51Dim RangeList 52RangeList = Split(copyRange, ",") 53 54'エラー情報をクリアする。 55Err.Clear 56 57 58' フォルダ内(サブフォルダも含む)でループしてコピー元ファイルを取得 59ShowSubfolders objFSO.GetFolder(copyFolder) 60 61Dim File 62Sub ShowSubFolders(Folder) 63 For Each File in Folder.Files 'フォルダ内のファイルを列挙する 64 'EXCELファイルか判定 65 Dim ext 66 ext = objFSO.GetExtensionName(File.Name) 67 68 If ext = "xlsx" Or ext = "xlsm" Then 69 ' 変数定義 70 Dim copyFilePath, pasteFilePath, templateFilePath, copyExcelObj, pasteExcelObj 71 Dim copyFileObj, pasteFileObj, copySheetObj, pasteSheetObj 72 73 templateFilePath = templateFolder & "\" & templateFileName 74 copyFilePath = copyFolder & "\" & File.Name 75 pasteFilePath = pasteFolder & "\" & File.Name 76 77 ' コピー元と同じファイル名でコピー先ファイルを生成 78 objFSO.CopyFile templateFilePath, pasteFilePath, True 79 80 ' コピーエラー発生時は終了する 81 If Err.Number <> 0 Then 82 Set File = Nothing 83 Set objFSO = Nothing 84 85 WScript.Echo "テンプレートコピーでエラーが発生したため終了します。" 86 WScript.Quit 87 End If 88 89 ' コピー元ファイルを開く 90 Set copyExcelObj = WScript.CreateObject("Excel.Application") 91 Set copyFileObj = copyExcelObj.Workbooks.Open(copyFilePath) 92 Set copySheetObj = copyFileObj.Worksheets(copySheetName) 93 94 95 ' コピー先ファイルを開く 96 Set pasteExcelObj = WScript.CreateObject("Excel.Application") 97 Set pasteFileObj = pasteExcelObj.Workbooks.Open(pasteFilePath) 98 Set pasteSheetObj = pasteFileObj.Worksheets(pasteSheetName) 99 100 pasteSheetObj.Activate 101 102 ' コピー対象セル範囲を取得(リストで保持) 103 Dim RangeVal 104 For Each RangeVal in RangeList 105 RangeVal = Replace(Replace(RangeVal, "[", ""), "]", "") 106 107 copySheetObj.Range(RangeVal).Copy 108 109 ' コピー先ファイルにペースト 110 'pasteSheetObj.Range("A1").Select 111 ' -4104 112 pasteSheetObj.Range(RangeVal).PasteSpecial(-4104) 113 114 Next 115 116 pasteFileObj.Save 117 pasteFileObj.Close 118 119 copyExcelObj.Quit 120 pasteExcelObj.Quit 121 122 Else 123 WScript.Echo "テンプレートコピーに失敗しました。" 124 WScript.Quit 125 End If 126 Next 127 128 Dim Subfolder 129 For Each Subfolder in Folder.SubFolders 'フォルダ内のフォルダを列挙する 130 ShowSubFolders Subfolder '再帰呼び出し 131 Next 132End Sub 133 134WScript.Echo "テストデータコピーが完了しました。" 135WScript.Quit 136 137Set copyExcelObj = Nothing 138Set copyFileObj = Nothing 139Set copySheetObj = Nothing 140 141Set pasteExcelObj = Nothing 142Set pasteFileObj = Nothing 143Set pasteSheetObj = Nothing 144 145Set File = Nothing 146Set objFSO = Nothing 147 148Set Subfolder = Nothing 149
回答1件
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2018/06/26 08:31