Soy nuevo en VbScript. Estoy tratando de copiar todas las hojas en una carpeta en un solo libro. Se trata de conseguir el copiado pero muestra un error antes de guardar el libro de trabajo nuevo. error:«el objeto invocado es desconectado de sus clientes». código: 80010108. Por favor me ayude. Aquí está mi código.

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 & "\" & 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

2 Comentarios

  1. 3

    El problema es que el nuevo objeto ahora es wbDst y no objWorkbook

    El objeto objWorkbook ya estaba destruido. Se ha declarado un nuevo objeto wbDst en esta línea

    set wbDst = objExcel.workbooks.open(strFileName)

    Así que simplemente cambiar la línea

    objWorkbook.SaveAs(strFileName)

    a

    wbDst.Save

    Usted no necesita un .SaveAs de nuevo

    Idealmente, usted no necesita salir y cerrar excel. Usted puede mantener abierto el archivo y en lugar de utilizar wbDst, uso objWorkbook

    EDITAR

    El código puede ser re-escrita como (no PROBADO).

    Nota: Usted necesita cerrar wbSrc como bien lo contrario tendrá gran cantidad de archivos abiertos.

    Dim strFileName, strDirectory, counter, extension, Temp
    Dim intMessage, FileName, wbSrc
    Dim objFSO, objFolder, objFile, objExcel, objWorkbook
    
    strFileName = "C:\Users\ARUN\Desktop\LD.xlsx"
    
    Set objExcel = CreateObject("Excel.Application")
    objExcel.Visible = True
    
    Set objWorkbook = objExcel.Workbooks.Add()
    objWorkbook.SaveAs (strFileName)
    
    extension = "xlsx"
    
    strDirectory = "C:\Users\ARUN\Desktop\Excel Merger Project"
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(strDirectory)
    
    counter = 0
    
    For Each objFile In objFolder.Files
        If LCase((objFSO.GetExtensionName(objFile))) = LCase(extension) Then
            counter = counter + 1
            FileName = objFile.Name
            FileName = strDirectory & "\" & FileName
            Set wbSrc = objExcel.Workbooks.Open(FileName)
            wbSrc.Sheets(1).Copy objWorkbook.Sheets(counter)
            wbSrc.Close
        End If
    Next
    
    '~~> Close and Cleanup   
    objWorkbook.Save
    objWorkbook.Close
    objExcel.Quit
    
    Set wbSrc = Nothing
    Set objWorkbook = Nothing
    Set objExcel = Nothing

    Por CIERTO, el código puede ser más afinado. Por ejemplo, no se requiere el Counter variable.

    ÚLTIMA EDICIÓN

    PROBADO

    '~~> Change Paths as applicable
    Dim objExcel, objWorkbook, wbSrc
    Dim strFileName, strDirectory, extension, Filename
    Dim objFSO, objFolder, objFile
    
    strFileName = "C:\Users\Siddharth Rout\Desktop\LD.xlsx"
    
    Set objExcel = CreateObject("Excel.Application")
    objExcel.Visible = True
    
    Set objWorkbook = objExcel.Workbooks.Add()
    
    extension = "xlsx"
    
    strDirectory = "C:\Users\Siddharth Rout\Desktop\Excel Merger Project"
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(strDirectory)
    
    For Each objFile In objFolder.Files
        If LCase((objFSO.GetExtensionName(objFile))) = LCase(extension) Then
            Filename = objFile.Name
            Filename = strDirectory & "\" & Filename
            Set wbSrc = objExcel.Workbooks.Open(Filename)
            wbSrc.Sheets(1).Copy objWorkbook.Sheets(objWorkbook.Sheets.Count)
            wbSrc.Close
        End If
    Next
    
    '~~> Close and Cleanup
    objWorkbook.SaveAs (strFileName)
    objWorkbook.Close
    objExcel.Quit
    
    Set wbSrc = Nothing
    Set objWorkbook = Nothing
    Set objExcel = Nothing
    • Muchas gracias por su valiosa ayuda en mi segundo proyecto también 🙂 eres impresionante….
    • buena pieza de código 🙂
  2. 0

    Intentar comentar esta línea en el medio de la secuencia de comandos:

    'objExcel.Quit
    
    'created an empty excel file

    Cuando llame objExcel.Dejar de fumar, no hay instancia de Excel es la vida. Así que usted no puede hacer esto después de:

    set wbDst = objExcel.workbooks.open(strFileName)

    Como aquí objExcel está muerto – desconectado de Excel.Aplicación.

    Por favor, copie y pegue este código completo para las pruebas de:

    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 & "\" & 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
    • No su trabajo 🙁 todavía me sale el mismo error.

Dejar respuesta

Please enter your comment!
Please enter your name here