Question

代码将excel文档中的计算机列表添加到数组中。然后，它会查看这些计算机是否在目录文件夹中列为文件。如果计算机名称与文件夹中的文件匹配，则应将文本文件的内容添加到创建的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

Vbscript没有写入excel文档

1 个答案: