title: Copy Worksheet to a New WorkBook in VbScript - "the object invoked is disconnected from its clients" error code: 80010108
body: <p>I'm new to VbScript. I'm trying to copy all the worksheets in a folder to a single workbook. It is getting copied  but it is showing an error before saving the new workbook. error:<strong>"the object invoked is disconnected from its clients"</strong>. code: <strong>80010108</strong>. Please help me. Here is my code.</p>
  
  <pre><code>Option Explicit  
  'On Error Resume Next
  
  Dim strFileName, strDirectory, counter, extension, Temp
  Dim intMessage, FileName, wbSrc, wbDst
  Dim objFSO, objFolder, objFile, objExcel, objWorkbook
  
  'create an empty excel file starts
  
  strFileName = "C:\Users\ARUN\Desktop\LD.xlsx"
  
  Set objExcel = CreateObject("Excel.Application")
  objExcel.Visible = True
  
  Set objWorkbook = objExcel.Workbooks.Add()
  objWorkbook.SaveAs(strFileName)
  
  objExcel.Quit
  
  'created an empty excel file
  
  
  
  'file extension to look for
  extension = "xlsx"  
  
  'directory to look in
  'strDirectory = InputBox("Enter the Folder Path:","Folder Path")  
  strDirectory = "C:\Users\ARUN\Desktop\Excel Merger Project"
  counter = 0  
  
  'File Objects Initialization
  
  Set objFSO = CreateObject("Scripting.FileSystemObject")  
  Set objFolder = objFSO.GetFolder(strDirectory)  
  
  counter = 0
  
  set wbDst = objExcel.workbooks.open(strFileName)
  
  For Each objFile In objFolder.Files  
      if LCase((objFSO.GetExtensionName(objFile))) = LCase(extension) then  
          counter = counter + 1 
          'Get the file name  
          FileName = objFile.Name
          FileName = strDirectory &amp; "\" &amp; FileName
          msgbox(FileName)
          set wbSrc = objExcel.workbooks.open(FileName)
          wbSrc.sheets(wbSrc.Sheets(1).Name).copy wbDst.sheets(counter)
      end if
  Next
  
  objWorkbook.SaveAs(strFileName)
  objExcel.Quit
  </code></pre>