Macro en Word para leer recibos de nómina CFDI y extraer el ISR retenido automáticamente

Imagen
Macro en Word para leer recibos de nómina CFDI y extraer datos clave Si trabajas en contabilidad, seguramente has recibido archivos XML de recibos de nómina para revisión o conciliación. Esta macro te permite leer múltiples archivos CFDI versión 4.0 directamente desde Word, y extraer automáticamente los siguientes datos: RFC del Emisor RFC del Receptor Total del comprobante UUID ISR Retenido (extraído del nodo de deducciones de nómina) Esto es especialmente útil para quienes deben validar cantidades retenidas de ISR en recibos de nómina digitales y quieren presentar su declaración anual o para contadores. La macro coloca toda la información organizada en una tabla dentro del documento Word, lista para copiar o validar. ¿Cómo funciona? Al ejecutar la macro: Seleccionas uno o varios archivos XML desde tu computadora Word los analiza uno por uno Se genera automáticamente una tabla con los datos clave ¿Quién puede usar esta macro? Está pensada para c...

Macro leer datos Base Datos

Código de macro completo para leer datos de QAD 


Private Sub CommandButton1_Click()
Dim cn400 As ADODB.Connection
Dim rg400 As ADODB.Recordset
Dim cmdString As ADODB.Command
Dim strcon As String
Dim parte As String
Dim Row As Integer
Dim exrate As Double
Dim abc_type As String
Dim vc_oid_pt_mstr As Double
ActiveSheet.Unprotect Password:="testpass"

If Range("B4") = "" Then
MsgBox "No Item found in Cell B4."
Exit Sub
End If

strcon = "Provider=SQLOLEDB; Data Source = base_datos; User id=base_datos_user; Password=pass_word"

    Set cn400 = New ADODB.Connection
    Set rg400 = New ADODB.Recordset
    Set cmdString = New ADODB.Command
Sheet5.Range("A8:C22") = ""
Call cn400.Open(strcon)
parte = Sheet5.Range("B4")
cmdString.CommandType = adCmdText
Set cmdString.ActiveConnection = cn400
'PT description
cmdString.CommandText = "Select pt_desc1, pt_desc2, pt_abc, oid_pt_mstr from pt_mstr where (pt_domain = 'domain' AND pt_part ='" + parte + "')"
 Set rg400 = cmdString.Execute(RecordsAffected, ExecuteOptionEnum.adAsyncFetch)
Row = 4
    Do While Not rg400.EOF
        Cells(Row, 4).Value = rg400.Fields(0).Value + rg400.Fields(1).Value
        abc_type = rg400.Fields(2).Value
        vc_oid_pt_mstr = rg400.Fields(3).Value
        Row = Row + 1
        rg400.MoveNext
    Loop
rg400.Close

'abc type
cmdString.CommandText = "Select pti_abc from pti_det where (pti_det.oid_pt_mstr = " + Str(vc_oid_pt_mstr) + ")"
Set rg400 = cmdString.Execute(RecordsAffected, ExecuteOptionEnum.adAsyncFetch)
Do While Not rg400.EOF
        abc_type = rg400.Fields(0).Value
        Row = Row + 1
        rg400.MoveNext
    Loop
rg400.Close

Cells(3, 4).Value = abc_type

'exchange rate
cmdString.CommandText = "Select code_cmmt from code_mstr where (code_domain  = 'domain' AND code_fldname = 'xxprocess-general' AND code_value   = 'exchange-rate-usd')"
 Set rg400 = cmdString.Execute(RecordsAffected, ExecuteOptionEnum.adAsyncFetch)
 exrate = rg400.Fields(0).Value
'costo
cmdString.CommandText = "Select sct_cst_tot from sct_det where (sct_domain = 'domain' AND sct_sim = 'STANDARD' AND sct_site = 'site'AND sct_part ='" + parte + "')"
 Set rg400 = cmdString.Execute(RecordsAffected, ExecuteOptionEnum.adAsyncFetch)
Row = 3
    Do While Not rg400.EOF
        Cells(Row, 6).Value = rg400.Fields(0).Value / exrate
        Row = Row + 1
        rg400.MoveNext
    Loop
rg400.Close

'inventario in locations
cmdString.CommandText = "Select ld_loc, ld_qty_oh from ld_det where (ld_domain = 'domain' AND ld_site = 'site' AND ld_part ='" + parte + "')"
 Set rg400 = cmdString.Execute(RecordsAffected, ExecuteOptionEnum.adAsyncFetch)
Row = 8
    Do While Not rg400.EOF
        Cells(Row, 1).Value = rg400.Fields(0).Value
        Cells(Row, 2).Value = rg400.Fields(1).Value
        Row = Row + 1
        rg400.MoveNext
    Loop
rg400.Close
' ActiveSheet.Protect Password:="testpass", DrawingObjects:=True, Contents:=True, Scenarios:=True
 ActiveWorkbook.Save

End Sub

Comentarios

🚀 Mantener este blog funcionando requiere tiempo y café. ¡Puedes contribuir con uno aquí!

Entradas más populares de este blog

Guía Práctica: Ejemplo Completo de ASPX para Desarrolladores Web

📊 Automatiza tu trabajo: Convierte tablas de Word a Excel con una macro

Macro de Excel para abrir archivo csv