vbscriptexcel.application

Transferring data between Excel sheets

This is my script which opens Excel files and takes info from some cells then inserts it in another Excel document. I have included the entire script but marked where I think the error is. I am really confused at why this isn't working as I am using the exact same method in another script that works perfectly.

updated code from answers, same problem remains. I think it's being caused by the Find_Excel_Row.

I tried putting the script in the function in the loop so there was no problem with variables but I got the same error.

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
Solution

  • In addition to what @Ekkehard.Horner said, you can't use the Excel object after quitting, so you should be getting an error when trying to open 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          <<<

    In fact, you're closing the application at several points in your script. Don't do that. Create the Excel instance once, use this one instance throughout your entire script, and terminate it when your script ends.

    Edit: This is what causes your issue:

    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               '<<<

    You assign Range objects (returned by the Cells property) to the variables Stock and ID, but then close the workbook with the data these objects reference.

    Since you want to transfer values anyway, assign the value of the respective cells to the variables Stock and ID:

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

    Also, I'd recommend to avoid using the Cells property of the application object. Instead use the respective property of the actual worksheet containing the data so it becomes more obvious what you're referring to:

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

    After you fixed that you'll most likely run into the next issue with the following lines:

    oBook2.Save
oBook2.Close

    You're closing oBook2 inside a loop without exiting from the loop. That should raise an error in the next iteration (when you try to assign the next values to the already closed workbook). Move the above two statements outside the loop or, better yet, move them to the Init procedure (after the Call Read_Write statement). From a handling perspective it's best to close/discard objects in the same context in which they were created (if possible). Helps avoiding attempts to use objects before they were created or after they were destroyed.

    To further optimize your script you could even avoid the intermediate variables Stock and ID and transfer the values directly:

    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