0

这是我的脚本，它打开 Excel 文件并从某些单元格中获取信息，然后将其插入到另一个 Excel 文档中。我已经包含了整个脚本，但标记了我认为错误所在的位置。我真的很困惑为什么这不起作用，因为我在另一个完美运行的脚本中使用完全相同的方法。

从答案更新代码，同样的问题仍然存在。我认为这是由Find_Excel_Row.

我尝试将脚本放在循环中的函数中，所以变量没有问题，但我得到了同样的错误。

Dim FSO             'File system Object
Dim folderName      'Folder Name
Dim FullPath        'FullPath
Dim TFolder         'Target folder name
Dim TFile           'Target file name
Dim TFileC          'Target file count
Dim oExcel          'The Excel Object
Dim oBook1          'The Excel Spreadsheet object
Dim oBook2
Dim oSheet          'The Excel sheet object
Dim StrXLfile       'Excel file for recording results
Dim bXLReadOnly     'True if the Excel spreadsheet has opened read-only
Dim strSheet1       'The name of the first Excel sheet
Dim r, c            'row, column for spreadsheet
Dim bFilled         'True if Excel cell is not empty
Dim iRow1           'the row with lower number in Excel binary search
Dim iRow2           'the row with higher number in Excel binary search
Dim iNumpasses      'Number of times through the loop in Excel search
Dim Stock           'product stock levels
Dim ID              'product ID 
Dim Target          'Target file
Dim Cx              'Counter
Dim Cxx             'Counter 2
Dim RR, WR          'Read and Write Row

Call Init

Sub Init
  Set FSO = CreateObject("Scripting.FileSystemObject")

  FullPath = FSO.GetAbsolutePathName(folderName) 

  Set oExcel = CreateObject("Excel.Application")

  Target2 = CStr("D:\Extractor\Results\Data.xls")

  Set oBook2 = oExcel.Workbooks.Open(Target2)

  TFolder = InputBox ("Target folder")
  TFile   = InputBox ("Target file")
  TFileC  = InputBox ("Target file count")

  Call Read_Write
End Sub

Sub Read_Write
  RR = 6
  PC = 25

  For Cx = 1 to Cint(TFileC)
    Target  = CStr("D:\Extractor\Results\"& TFolder & "\"& TFile & Cx &".html")

    For Cxx = 1 to PC
      Call Find_Excel_Row

      Set oBook1 = oExcel.Workbooks.Open(Target)

      Set Stock  = oExcel.Cells(RR,5)
      Set ID     = oExcel.Cells(RR,3)

      MsgBox ( Cxx &"/25 " &" RR: "& RR & " ID: " & ID & " Stock: " & Stock )

      oBook1.Close

      MsgBox "Writing Table"
      oExcel.Cells(r,4).value = Stock            '<<<  Area of issue
      oExcel.Cells(r,2).value = ID               '<<<

      oBook2.Save
      oBook2.Close

      Cxx = Cxx + 1
      RR = RR + 1
    Next
    Cx = Cx + 1
  Next

  MsgBox "End"

  oExcel.Quit
End sub

Sub Find_Excel_Row
  bfilled     = False
  iNumPasses  = 0
  c           = 1
  iRow1       = 2
  iRow2       = 10000

  Set oSheet = oBook2.Worksheets.Item("Sheet1")

  'binary search between iRow1 and iRow2
  Do While (((irow2 - irow1)>3) And (iNumPasses < 16))
    'Set current row
    r = Round(((iRow1 + iRow2) / 2),0)

    'Find out if the current row is blank
    If oSheet.Cells(r,c).Value = "" Then
      iRow2 = r + 1
    Else
      iRow1 = r - 1
    End If

    iNumPasses = iNumPasses + 1
  Loop

  r = r + 1

  'Step search beyond the point found above
  While bFilled = False
    If oSheet.Cells(r,c).Value = "" Then
      bFilled = True
    Else
      r = r + 1
    End If
  Wend

  oExcel.Workbooks.Close
End Sub
4

2 回答 2

1

除了@Ekkehard.Horner所说，退出后您无法使用 Excel 对象，因此您在尝试打开时应该会收到错误消息Data.xls。

oExcel.Workbooks.Close
oExcel.Quit

'writes to Graph sheet
set oBook = oExcel.Workbooks.Open("D:\Extractor\Results\Data.xls")
'           ^^^^^^ This should be giving you an error
'Writing Table
MsgBox "Writing Table"
oExcel.Cells(r,4).value = Stock       <<< Error here
oExcel.Cells(r,2).value = ID          <<<

事实上，您正在脚本中的多个位置关闭应用程序。不要那样做。创建一次 Excel 实例，在整个脚本中使用这个实例，并在脚本结束时终止它。

编辑：这就是导致您的问题的原因：

Set Stock  = oExcel.Cells(RR,5)
Set ID     = oExcel.Cells(RR,3)
...
oBook1.Close
...
oExcel.Cells(r,4).value = Stock            '<<<  Area of issue
oExcel.Cells(r,2).value = ID               '<<<

您将Range对象（由Cells属性返回）分配给变量Stock和ID，然后使用这些对象引用的数据关闭工作簿。

由于您无论如何都想传输值，请将各个单元格的值分配给变量Stock和ID：

Stock  = oExcel.Cells(RR,5).Value
ID     = oExcel.Cells(RR,3).Value

另外，我建议避免使用Cells应用程序对象的属性。而是使用包含数据的实际工作表的相应属性，以便您所指的内容变得更加明显：

Stock  = oBook1.Sheets(1).Cells(RR,5).Value
ID     = oBook1.Sheets(1).Cells(RR,5).Value

修复后，您很可能会遇到以下几行的下一个问题：

oBook2.Save
oBook2.Close

您正在关闭oBook2一个循环而不退出循环。这应该会在下一次迭代中引发错误（当您尝试将下一个值分配给已经关闭的工作簿时）。将上述两个语句移到循环之外，或者更好的是，将它们移到Init过程中（在Call Read_Write语句之后）。从处理的角度来看，最好在创建对象的同一上下文中关闭/丢弃对象（如果可能）。有助于避免在创建对象之前或销毁对象之后尝试使用它们。

为了进一步优化您的脚本，您甚至可以避免中间变量Stock并ID直接传输值：

oBook2.Sheets(1).Cells(r,4).value = oBook1.Sheets(1).Cells(RR,5).Value
oBook2.Sheets(1).Cells(r,2).value = oBook1.Sheets(1).Cells(RR,5).Value
于 2015-08-27T11:45:17.927 回答
1

在嵌套循环中重复使用相同的循环控制变量（计数）是非法的：

Option Explicit

Dim bad_loop_counter
For bad_loop_counter = 1 To 2
    WScript.Echo "outer", bad_loop_counter
    For bad_loop_counter = 1 To 2
        WScript.Echo "inner", bad_loop_counter
    Next
Next

输出：

cscript 32246593.vbs
... 32246593.vbs(6, 26) Microsoft VBScript compilation error: Invalid 'for' loop control variable

所以你的代码甚至不会编译。

于 2015-08-27T10:34:55.110 回答