因为在项目自动化实施过程中,需要将一些文本结果生成到excel中的,因而将代码总结如下: Call GetIni("E:/test/result.txt","E:/test/key.txt") Function GetIni(strResultPath,strKeyPath) Const ForReading = 1 Const TriStateTrue = -2 Dim myFso Dim MyFile Dim strState Dim Range_i Range_i=1 Set myFso = CreateObject("Scripting.FileSystemObject") Dim ExcellApp 'As Excel.Application Dim excelSheet1 'As Excel.worksheet Set ExcelApp = CreateExcel() 'Create a workbook with two worksheets ret = RenameWorksheet(ExcelApp, "Book1", "Sheet1", "自动化评测结果") ret = RemoveWorksheet(ExcelApp, "Book1", "Sheet2") ret = RemoveWorksheet(ExcelApp, "Book1", "Sheet3") 'SaveAs the work book ret = SaveWorkbook(ExcelApp, "Book1", "E:/Example1.xls") Set excelSheet1 = GetSheet(ExcelApp, "自动化评测结果") Set MyFile = myFso.OpenTextFile(strResultPath,ForReading,False,TriStateTrue) Set KeyFile = myFso.OpenTextFile(strKeyPath,ForReading,False,TriStateTrue) Do Until KeyFile.AtEndOfStream strState = MyFile.ReadLine() strKey=KeyFile.ReadLine() If UCase(Left(strState, Len(strKey & "="))) = UCase(strKey & "=") Then GetValue = Right(strState, Len(strState) - Len(strKey & "=")) ' MsgBox GetValue SetCellValue excelSheet1, Range_i, 2, GetValue Range_i=Range_i+1 End If Loop MyFile.Close SaveWorkbook ExcelApp, 1, "" CloseExcel ExcelApp Set MyFile = Nothing Set myFso = Nothing End Function Function CreateExcel() 'As Excel.Application Dim excelSheet 'As Excel.worksheet Set ExcelApp = CreateObject("Excel.Application") 'Create a new excel Object ExcelApp.Workbooks.Add ExcelApp.Visible = True Set CreateExcel = ExcelApp End Function Function RenameWorksheet(ExcelApp, workbookIdentifier, worksheetIdentifier, sheetName) 'As String Dim workbook 'As Excel.workbook Dim worksheet 'As Excel.worksheet On Error Resume Next Err = 0 Set workbook = ExcelApp.Workbooks(workbookIdentifier) If Err <> 0 Then RenameWorksheet = "Bad Workbook Identifier" Err = 0 Exit Function End If Set worksheet = workbook.Sheets(worksheetIdentifier) If Err <> 0 Then RenameWorksheet = "Bad Worksheet Identifier" Err = 0 Exit Function End If worksheet.Name = sheetName RenameWorksheet = "OK" End Function Function GetSheet(ExcelApp, sheetIdentifier) 'As Excel.worksheet On Error Resume Next Set GetSheet = ExcelApp.Worksheets.Item(sheetIdentifier) On Error GoTo 0 End Function Sub SetCellValue(excelSheet, row, column, value) On Error Resume Next excelSheet.Cells(row, column) = value On Error GoTo 0 End Sub Function RemoveWorksheet(ExcelApp, workbookIdentifier, worksheetIdentifier) 'As String Dim workbook 'As Excel.workbook Dim worksheet 'As Excel.worksheet On Error Resume Next Err = 0 Set workbook = ExcelApp.Workbooks(workbookIdentifier) If Err <> 0 Then RemoveWorksheet = "Bad Workbook Identifier" Exit Function End If Set worksheet = workbook.Sheets(worksheetIdentifier) If Err <> 0 Then RemoveWorksheet = "Bad Worksheet Identifier" Exit Function End If worksheet.Delete RemoveWorksheet = "OK" End Function Function SaveWorkbook(ExcelApp, workbookIdentifier, path) 'As String Dim workbook 'As Excel.workbook On Error Resume Next Set workbook = ExcelApp.Workbooks(workbookIdentifier) On Error GoTo 0 If Not workbook Is Nothing Then If path = "" Or path = workbook.FullName Or path = workbook.Name Then workbook.Save Else Set fso = CreateObject("Scripting.FileSystemObject") 'if the path has no file extension then add the 'xls' extension If InStr(path, ".") = 0 Then path = path & ".xls" End If On Error Resume Next fso.DeleteFile path Set fso = Nothing Err = 0 On Error GoTo 0 workbook.SaveAs path End If SaveWorkbook = "OK" Else SaveWorkbook = "Bad Workbook Identifier" End If End Function Sub CloseExcel(ExcelApp) Set excelSheet = ExcelApp.ActiveSheet Set excelBook = ExcelApp.ActiveWorkbook Set fso = CreateObject("Scripting.FileSystemObject") On Error Resume Next ExcelApp.Quit Set ExcelApp = Nothing Set fso = Nothing Err = 0 On Error GoTo 0 Set fso = Nothing End Sub