帮我看看VBS删除EXCEL的空白行哪里出错了？

[zhejin]

帮我看看VBS删除EXCEL的空白行哪里出错了？

Dim RowID
strPath = "C:\Documents and Settings\Administrator\1"

Set objExcel = CreateObject("Excel.Application")
objExcel.DisplayAlerts = False
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set FileList = objWMIService.ExecQuery ("ASSOCIATORS OF {Win32_Directory.Name='" & strPath & "'} Where " & "ResultClass = CIM_DataFile")
For Each objFile In FileList
If objFile.Extension = "xls" Then
DeleteBlankEntireRowDemo objFile.Name
End If
Next
objExcel.Quit

Sub DeleteBlankEntireRowDemo(strXlsFile)
On Error Resume Next
Set objWorkbook = objExcel.Workbooks.Open(strXlsFile,,,,strOldPassword,strOldWritePassword,True)
For RowID = Range(Cells(1, 1), objWorkbook.ActiveSheet.UsedRange).Rows.Count To 1 Step -1
If Application.WorksheetFunction.CountBlank(objWorkbook.ActiveSheet.Rows(RowID).EntireRow) = 256 Then objWorkbook.ActiveSheet.Rows(RowID).Delete
Next

objWorkbook.Save
objWorkbook.Close
End Sub

[klj123]

怎么不用VBA呢？

[terrywolf]

[Quote=引用 1 楼 klj123 的回复:]
怎么不用VBA呢？
[/Quote]为什么不能用VB呢?

顶起来!

[qqlpp]

up

[lyserver]

代码有两处错误，改正后如下：
Dim RowID
strPath = "C:\Documents and Settings\Administrator\1"

Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.DisplayAlerts = False
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set filelist = objWMIService.ExecQuery("ASSOCIATORS OF {Win32_Directory.Name='" & strPath & "'} Where " & "ResultClass = CIM_DataFile")
For Each objfile In filelist
If objfile.Extension = "xls" Then
DeleteBlankEntireRowDemo objfile.Name
End If
Next
objExcel.Quit

Sub DeleteBlankEntireRowDemo(strXlsFile)
' On Error Resume Next
Set objWorkBook = objExcel.Workbooks.Open(strXlsFile, , , , strOldPassword, strOldWritePassword, True)

For RowID = objWorkBook.ActiveSheet.UsedRange.Rows.Count To 1 Step -1
If objWorkBook.Application.WorksheetFunction.CountBlank(objWorkBook.ActiveSheet.Rows(RowID).EntireRow) = 256 Then objWorkBook.ActiveSheet.Rows(RowID).Delete
Next

objWorkBook.Save
objWorkBook.Close

End Sub

[zhejin]

这个代码只能修改ActiveSheet 如果一个文件有三个工作表 如何修改啊？

[lyserver]

下面代码可以处理任意个工作表
Dim strPath, strComputer
Dim objExcel, objWorkBook, objSheet, objWMIService, objFile, FileList

strPath = "C:\Documents and Settings\Administrator\1"
Set objExcel = CreateObject("Excel.Application")
objExcel.DisplayAlerts = False
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set FileList = objWMIService.ExecQuery("ASSOCIATORS OF {Win32_Directory.Name='" & strPath & "'} Where " & "ResultClass = CIM_DataFile")
For Each objFile In FileList
If objFile.Extension = "xls" Then
DeleteBlankEntireRowDemo objFile.Name
End If
Next
objExcel.Quit

Sub DeleteBlankEntireRowDemo(strXlsFile)
Dim RowID, SheetID
Dim strOldPassword, strOldWritePassword
Set objWorkBook = objExcel.Workbooks.Open(strXlsFile, , , , strOldPassword, strOldWritePassword, True)

For SheetID = 1 To objWorkBook.Sheets.Count
Set objSheet = objWorkBook.Sheets(SheetID)
For RowID = objSheet.UsedRange.Rows.Count To 1 Step -1
If objWorkBook.Application.WorksheetFunction.CountBlank(objSheet.Rows(RowID).EntireRow) = 256 Then objSheet.Rows(RowID).Delete
Next
Next
objWorkBook.Save
objWorkBook.Close
End Sub

[lyserver]

把代码复制到记事本中，保存为test.vbs，双击运行即可，LZ还可以在objExcel.Quit
后加上一行代码MsgBox "空白行已删除完毕!"，以便知道是否运行完毕。

[wap21]

友情up