Vbscript不写入excel文件

该代码将Excel文档中的机器列表添加到数组中。 然后，它会看到这些机器是否被列为目录文件夹中的文件。 如果机器名称与文件夹中的文件相匹配，则应该将文本文件的内容添加到创build的Excel文档中。 代码似乎工作正常，除了它不写入数据到Excel文档。 任何帮助，将不胜感激！

Option Explicit 'This section Adds file names from Excel to Array Dim arrExcelValues() Dim objExcel, objWorkbook, strItem, i, x Set objExcel = CreateObject ("Excel.Application") Set objWorkbook = objExcel.Workbooks.Open("C:\Users\jm\Test.xls") objExcel.Visible = True i = 1 x = 0 Do Until objExcel.Cells(i, 1).Value = "" ReDim Preserve arrExcelValues(x) arrExcelValues (x) = objExcel.Cells(i, 1).Value i = i + 1 x = x + 1 Loop objExcel.Quit 'This section checks the array names against files and then adds them to an excel file if found Dim objFile, strDirectory, objfLD, objFSO, strFolder, objTS, FIL, strFilename, arraypos, ExcelPos, strContents, objTextFile, strFileLocation, objSheet, strExcelPath Const ForReading = 1 Const xlExcel7 = 39 strFolder = "C:\Users\jm\Machines" strExcelPath = "C:\Users\jm\myfile.xls" Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFLD = objFSO.GetFolder(strFolder) ExcelPos = 1 strFilename = arrExcelValues(arraypos) Set objExcel = CreateObject("Excel.Application") objExcel.Workbooks.Add Set objSheet = objExcel.ActiveWorkbook.WorkSheets(1) objSheet.Name = "Machines" For Each Fil IN objFLD.Files For arraypos=0 to UBound(arrExcelValues) strFilename = arrExcelValues(arraypos) & "-Corp1" If Fil.name = strFilename Then strFileLocation = strFolder & "\" & strFilename Set objTextFile = objFSO.OpenTextFile (strFileLocation, ForReading) Do Until objTextFile.AtEndofStream strContents = objTextFile.ReadLine Loop objTextFile.Close objSheet.Cells(1, ExcelPos).Value = strContents ExcelPos = ExcelPos + 1 End If Next Next For Each Fil IN objFLD.Files For arraypos=0 to UBound(arrExcelValues) strFilename = arrExcelValues(arraypos) & "-Corp2" If Fil.name = strFilename Then strFileLocation = strFolder & "\" & strFilename Set objTextFile = objFSO.OpenTextFile (strFileLocation, ForReading) Do Until objTextFile.AtEndofStream strContents = objTextFile.ReadLine Loop objTextFile.Close objSheet.Cells(1, ExcelPos).Value = strContents ExcelPos = ExcelPos + 1 End If Next Next objExcel.ActiveWorkbook.SaveAs strExcelPath, xlExcel7 objExcel.ActiveWorkbook.Close objExcel.Application.Quit WScript.Echo "Finished." WScript.Quit 

Answer 1

我想到了！

 Option Explicit 'This section Adds file names from Excel to Array Dim arrExcelValues() Dim objExcel, objWorkbook, strItem, i, x Set objExcel = CreateObject ("Excel.Application") Set objWorkbook = objExcel.Workbooks.Open("C:\Users\jm\Test.xls") objExcel.Visible = True i = 1 x = 0 Do Until objExcel.Cells(i, 1).Value = "" ReDim Preserve arrExcelValues(x) arrExcelValues (x) = objExcel.Cells(i, 1).Value i = i + 1 x = x + 1 Loop objExcel.Quit 'This section checks the array names against files and then adds them to an excel file if found Dim objFile, strDirectory, objfLD, objFSO, strFolder, objTS, FIL, strFilename, arraypos, ExcelPos, strContents, objTextFile, strFileLocation, objSheet, strExcelPath, colFiles, File Const ForReading = 1 Const xlExcel7 = 39 strFolder = "C:\Users\jm\Machines" strExcelPath = "C:\Users\jm\myfile.xls" Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFLD = objFSO.GetFolder(strFolder) Set colFiles = objFLD.files ExcelPos = 1 strFilename = arrExcelValues(arraypos) Set objExcel = CreateObject("Excel.Application") objExcel.Workbooks.Add Set objSheet = objExcel.ActiveWorkbook.WorkSheets(1) objSheet.Name = "Machines" For Each File IN colFiles For arraypos=0 to UBound(arrExcelValues) strFilename = arrExcelValues(arraypos) & "-Domain1.txt" If File.name = strFilename Then strFileLocation = strFolder & "\" & strFilename Set objTextFile = objFSO.OpenTextFile (strFileLocation, ForReading) Do Until objTextFile.AtEndofStream strContents = objTextFile.ReadLine Loop objTextFile.Close objSheet.Cells(ExcelPos, 1).Value = strContents ExcelPos = ExcelPos + 1 End If Next Next For Each File IN colFiles For arraypos=0 to UBound(arrExcelValues) strFilename = arrExcelValues(arraypos) & "-Domain2.txt" If File.name = strFilename Then strFileLocation = strFolder & "\" & strFilename Set objTextFile = objFSO.OpenTextFile (strFileLocation, ForReading) Do Until objTextFile.AtEndofStream strContents = objTextFile.ReadLine Loop objTextFile.Close objSheet.Cells(ExcelPos, 1).Value = strContents ExcelPos = ExcelPos + 1 End If Next Next objExcel.ActiveWorkbook.SaveAs strExcelPath, xlExcel7 objExcel.ActiveWorkbook.Close objExcel.Application.Quit WScript.Echo "Finished." WScript.Quit