Saltar al contenido

Macros que al ejecutarse se detiene y aparece este mensaje: error '-2147023170(800706be) en tiempo de ejecución: error de automarización

publicado

Tengo un código VBA para una macros que tiene que colocar los números en forma consecutiva desde la fila 3239 hasta la 3850, pero solo en las columnas A, B, C y D.  Ejemplo: el único rango que tiene números es el A3238:D3238, y son 34, 36, 38, 40. La macro hace que el rango A3239:D3239 aparezcan los números 35, 37, 39, 41, así hasta terminar en la fila 3850 o rango A3850:D3850. Tiene que ejecutarse en una carpeta especifica que tiene más de 70 mil archivos xlsx, de 2000 kb cada uno, y tienen una sola hoja. Lo hace, pero siempre se detiene cuando lo ha hecho en 9250 archivos, mostrando este mensaje: error '-2147023170(800706be) en tiempo de ejecución: error de automatización, Por lo que tengo que sacar los archivos que ya hizo el cambio, y volver a ejecutarla, y así solo lo realiza en 9250 archivos, y no en todos los archivos de la carpeta, Les dejo el código, a ver si me pueden alumbrar en que está fallando. La rapidez es importante y este código lo hace, pero siempre se detiene cuando ha hecho 9250 archivos.  Gracias desde ya.

Sub SumarEnRangoOptimizado()
    Dim folderPath As String
    Dim fileName As String
    Dim excelApp As Object
    Dim wb As Object
    Dim ws As Object
    
    ' Carpeta que contiene los archivos
    folderPath = "D:\Carpeta\"

    ' Deshabilitar actualizaciones de pantalla y cálculos automáticos
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    ' Crear una instancia de Excel Application
    Set excelApp = CreateObject("Excel.Application")
    excelApp.DisplayAlerts = False ' Desactivar las alertas

    ' Iterar sobre los archivos en la carpeta
    fileName = Dir(folderPath & "\*.xlsx")
    Do While fileName <> ""
        ' Abrir el archivo
        Set wb = excelApp.Workbooks.Open(folderPath & "\" & fileName)
        Set ws = wb.Sheets(1) ' Primera hoja de trabajo
        
        ' Aplicar la fórmula directamente en el rango
        With ws
            .Range("A3239:D3850").Formula = "=A$3238 + (ROW()-3238)"
            .Range("A3239:D3850").Value = .Range("A3239:D3850").Value ' Convertir las fórmulas en valores
        End With
        
        ' Cerrar el archivo sin guardar cambios
        wb.Close SaveChanges:=True
        
        ' Obtener el siguiente archivo en la carpeta
        fileName = Dir
    Loop

    ' Cerrar la instancia de Excel Application
    excelApp.Quit
    Set excelApp = Nothing

    ' Habilitar actualizaciones de pantalla y cálculos automáticos
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    MsgBox "La operación se ha completado en todos los archivos de la carpeta.", vbInformation
End Sub
 

Macros suma abcd.xlsm

Featured Replies

publicado

Hola, no tengo experiencia con ese error así que lo busque en Google y me devolvió esto:

El error ‘-2147023170(800706be) generalmente ocurre cuando se intenta acceder a un objeto que ya no está disponible.

Entonces no estoy seguro que lo siguiente funcione pero parece que al ser tantos archivos ocupa demasiada memoria en cada iteración del bucle. Si es así lo que podría recomendarte sería establecer los objetos de excel como wb y ws en el NOTHING después de que ya los uso.

Algo así: 

' Cerrar el archivo sin guardar cambios
wb.Close SaveChanges:=True

' Liberar la memoria
Set ws = Nothing
Set wb = Nothing

Además: 

' Cerrar la instancia de Excel Application
excelApp.Quit
Set excelApp = Nothing

Como mencionaba no estoy seguro que funcione pero es una idea, es con lo que puedo participar en tu consulta.

publicado

Prueba y comenta 

Sub SumarEnRangoOptimizado()
    Dim folderPath As String
    Dim fileName As String
    Dim excelApp As Object
    Dim wb As Object
    Dim ws As Object
    Dim rng As Object
    
    ' Carpeta que contiene los archivos
    folderPath = "D:\Carpeta\"

    ' Deshabilitar actualizaciones de pantalla y cálculos automáticos
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    ' Crear una instancia de Excel Application
    On Error Resume Next ' Manejar errores al intentar conectar con una instancia existente
    Set excelApp = GetObject(, "Excel.Application")
    On Error GoTo 0 ' Reactivar la gestión de errores normales si no se encuentra ninguna instancia existente
    
    If excelApp Is Nothing Then
        Set excelApp = CreateObject("Excel.Application")
        excelApp.DisplayAlerts = False ' Desactivar las alertas
    End If

    ' Iterar sobre los archivos en la carpeta
    fileName = Dir(folderPath & "\*.xlsx")
    Do While fileName <> ""
        ' Abrir el archivo
        Set wb = excelApp.Workbooks.Open(folderPath & "\" & fileName)
        Set ws = wb.Sheets(1) ' Primera hoja de trabajo
        
        ' Aplicar la fórmula directamente en el rango
        With ws
            Set rng = .Range("A3239:D3850")
            With rng
                .Formula = "=A$3238 + (ROW()-3238)"
                .Value = .Value ' Convertir las fórmulas en valores
            End With
        End With
        
        ' Cerrar el archivo sin guardar cambios
        wb.Close SaveChanges:=True
        
        ' Obtener el siguiente archivo en la carpeta
        fileName = Dir
    Loop

    ' Cerrar la instancia de Excel Application
    excelApp.Quit
    Set excelApp = Nothing

    ' Habilitar actualizaciones de pantalla y cálculos automáticos
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    MsgBox "La operación se ha completado en todos los archivos de la carpeta.", vbInformation
End Sub

 

publicado
  • Autor
hace 3 horas, JSDJSD dijo:

Prueba y comenta 

Sub SumarEnRangoOptimizado()
    Dim folderPath As String
    Dim fileName As String
    Dim excelApp As Object
    Dim wb As Object
    Dim ws As Object
    Dim rng As Object
    
    ' Carpeta que contiene los archivos
    folderPath = "D:\Carpeta\"

    ' Deshabilitar actualizaciones de pantalla y cálculos automáticos
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    ' Crear una instancia de Excel Application
    On Error Resume Next ' Manejar errores al intentar conectar con una instancia existente
    Set excelApp = GetObject(, "Excel.Application")
    On Error GoTo 0 ' Reactivar la gestión de errores normales si no se encuentra ninguna instancia existente
    
    If excelApp Is Nothing Then
        Set excelApp = CreateObject("Excel.Application")
        excelApp.DisplayAlerts = False ' Desactivar las alertas
    End If

    ' Iterar sobre los archivos en la carpeta
    fileName = Dir(folderPath & "\*.xlsx")
    Do While fileName <> ""
        ' Abrir el archivo
        Set wb = excelApp.Workbooks.Open(folderPath & "\" & fileName)
        Set ws = wb.Sheets(1) ' Primera hoja de trabajo
        
        ' Aplicar la fórmula directamente en el rango
        With ws
            Set rng = .Range("A3239:D3850")
            With rng
                .Formula = "=A$3238 + (ROW()-3238)"
                .Value = .Value ' Convertir las fórmulas en valores
            End With
        End With
        
        ' Cerrar el archivo sin guardar cambios
        wb.Close SaveChanges:=True
        
        ' Obtener el siguiente archivo en la carpeta
        fileName = Dir
    Loop

    ' Cerrar la instancia de Excel Application
    excelApp.Quit
    Set excelApp = Nothing

    ' Habilitar actualizaciones de pantalla y cálculos automáticos
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    MsgBox "La operación se ha completado en todos los archivos de la carpeta.", vbInformation
End Sub

 

Me marca error después de un rato igual que la mia.  Set wb = excelApp.Workbooks.Open(folderPath & "\" & fileName)

publicado
  • Autor
hace 8 horas, Israel Cassales dijo:

Hola, no tengo experiencia con ese error así que lo busque en Google y me devolvió esto:

El error ‘-2147023170(800706be) generalmente ocurre cuando se intenta acceder a un objeto que ya no está disponible.

Entonces no estoy seguro que lo siguiente funcione pero parece que al ser tantos archivos ocupa demasiada memoria en cada iteración del bucle. Si es así lo que podría recomendarte sería establecer los objetos de excel como wb y ws en el NOTHING después de que ya los uso.

Algo así: 

' Cerrar el archivo sin guardar cambios
wb.Close SaveChanges:=True

' Liberar la memoria
Set ws = Nothing
Set wb = Nothing

Además: 

' Cerrar la instancia de Excel Application
excelApp.Quit
Set excelApp = Nothing

Como mencionaba no estoy seguro que funcione pero es una idea, es con lo que puedo participar en tu consulta.

Igual me marca el mismo error  ‘-2147023170(800706be)

publicado
  • Autor
hace 3 horas, cathyuska dijo:

Igual me marca el mismo error  ‘-2147023170(800706be)

Disculpa me da este error: El error 462 "El equipo servidor remoto no existe o no está disponible" y en depurar :  wb.Close SaveChanges:=True

 
publicado

En ese caso es parece que está intentando cerrar un libro (wb) que ya se ha liberado.

Así que lo que podría agregar entonces es verificar el objeto antes de cerrarlo, intenta modificar el código: 

' Cerrar el archivo sin guardar cambios
If Not wb Is Nothing Then
    wb.Close SaveChanges:=True
    Set wb = Nothing
End If

Algo así verificará si el objeto wb existe (If Not wb Is Nothing) antes de intentar cerrarlo (wb.Close SaveChanges:=True). Si wb no existe, entonces el código para cerrarlo no se ejecutará, tratando de evitar el error

publicado
  • Autor
hace 4 horas, Abraham Valencia dijo:

Hola

Pregunta ¿Ejecutas esa macro directamente del archivo o cómo? Lo pregunto porque creas una instancia Excel y no me queda claro, ya que el método Open del objeto Workbooks actúa sin necesidad de crear una nueva instancia. 

Hola, directo del archivo

publicado

Parece ser cosa de la memoria y recursos de tu PC. Igual intenta así:

  

Sub SumarEnRangoOptimizado()
    
    Dim folderPath As String
    Dim fileName As String
    Dim wb As Workbook
    Dim ws As Worksheet
    
    ' Carpeta que contiene los archivos
    folderPath = "D:\Carpeta\"

    ' Deshabilitar actualizaciones de pantalla y cálculos automáticos
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    ' Crear una instancia de Excel Application
 '   Set excelApp = CreateObject("Excel.Application")
 '   excelApp.DisplayAlerts = False ' Desactivar las alertas

    ' Iterar sobre los archivos en la carpeta
    fileName = Dir(folderPath & "\*.xlsx")
    Do While fileName <> ""
        ' Abrir el archivo
        Set wb = Workbooks.Open(folderPath & "\" & fileName)
        Set ws = wb.Sheets(1) ' Primera hoja de trabajo
        
        ' Aplicar la fórmula directamente en el rango
        With ws
            .Range("A3239:D3850").Formula = "=A$3238 + (ROW()-3238)"
            .Range("A3239:D3850").Value = .Range("A3239:D3850").Value ' Convertir las fórmulas en valores
        End With
        
        ' Cerrar el archivo sin guardar cambios
        wb.Close SaveChanges:=True
        
        Set ws = Nothing
        Set wb = Nothing
        
        ' Obtener el siguiente archivo en la carpeta
        fileName = Dir
    Loop

    ' Cerrar la instancia de Excel Application
   ' excelApp.Quit
  '  Set excelApp = Nothing

    ' Habilitar actualizaciones de pantalla y cálculos automáticos
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    MsgBox "La operación se ha completado en todos los archivos de la carpeta.", vbInformation
End Sub

Comentas

publicado
  • Autor
En 29/2/2024 at 20:10 , Abraham Valencia dijo:

Parece ser cosa de la memoria y recursos de tu PC. Igual intenta así:

  

Sub SumarEnRangoOptimizado()
    
    Dim folderPath As String
    Dim fileName As String
    Dim wb As Workbook
    Dim ws As Worksheet
    
    ' Carpeta que contiene los archivos
    folderPath = "D:\Carpeta\"

    ' Deshabilitar actualizaciones de pantalla y cálculos automáticos
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    ' Crear una instancia de Excel Application
 '   Set excelApp = CreateObject("Excel.Application")
 '   excelApp.DisplayAlerts = False ' Desactivar las alertas

    ' Iterar sobre los archivos en la carpeta
    fileName = Dir(folderPath & "\*.xlsx")
    Do While fileName <> ""
        ' Abrir el archivo
        Set wb = Workbooks.Open(folderPath & "\" & fileName)
        Set ws = wb.Sheets(1) ' Primera hoja de trabajo
        
        ' Aplicar la fórmula directamente en el rango
        With ws
            .Range("A3239:D3850").Formula = "=A$3238 + (ROW()-3238)"
            .Range("A3239:D3850").Value = .Range("A3239:D3850").Value ' Convertir las fórmulas en valores
        End With
        
        ' Cerrar el archivo sin guardar cambios
        wb.Close SaveChanges:=True
        
        Set ws = Nothing
        Set wb = Nothing
        
        ' Obtener el siguiente archivo en la carpeta
        fileName = Dir
    Loop

    ' Cerrar la instancia de Excel Application
   ' excelApp.Quit
  '  Set excelApp = Nothing

    ' Habilitar actualizaciones de pantalla y cálculos automáticos
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    MsgBox "La operación se ha completado en todos los archivos de la carpeta.", vbInformation
End Sub

Comentas

lo hice. Hizo mas lento la ejecución pero esta bien. Gracias

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

Ir al listado de temas