none
Ayuda con Macro para generar un XML RRS feed

  • Pregunta

  • Buenos días expertos, gusto en saludarles. Tengo un problema con un código en VB.  Este es el código:

    Sub MakeXML()
    Dim MyRow As Integer, MyCol As Integer, Temp As String, YesNo As Variant, DefCarpeta As String
    Dim XMLFileName As String, XMLRecSetName As String, XMLRecSetName2 As String, MyLF As String, RTC1 As Integer
    Dim RangeOne As String, RangeTwo As String, Tt As String, FldName(99) As String
    Dim LastRow As Variant, Fila As Variant, Tipo As Integer, Fecha As String
    Dim Inicial As Double, Final As Double, BI As Double, IVA As Double, Texta As String, Switch As Integer
    Dim Periodo As Double, PeriodoElab As Double
    Dim Base As Double
    Dim Fechin As Variant
    Dim NumBase As String
    Dim NumIVA As String
    Dim Serie As String

    MyLF = Chr(10) & Chr(13)    ' comando de line feed
    DefCarpeta = "C:\Users\Administrador\Downloads\XML_Resultados\"   'cambie esta dirección donde se almacenaria el XML

    YesNo = MsgBox("Este Procedimiento requiere conocer la cantidad de filas del archivo !!" & MyLF _
     & "Ya determino la cantidad de filas ?", vbQuestion + vbYesNo, "Rutina XML Seniat")
     
    If YesNo = vbNo Then
     Debug.Print "El Usuario aborto con un 'No'"
     Exit Sub
    End If

    XMLFileName = "XML_Imprentas_Periodo_" & Cells(2, 8).Value & ".xml"


    XMLRecSetName = "Usuario"
    'XMLRecSetName2 = "P"

    FldName(0) = "Rif_proveedor"
    FldName(1) = "Rif_distribuidor"
    FldName(2) = "Rif_usuario" '"Rif_personal_tecnico"
    FldName(3) = "Numero_registro_maquina" '"Rif_distribuidor"
    FldName(4) = "Fecha_operacion" '"Periodo_declaracion" "Numero_registro_maquina"
    FldName(5) = "Tipo_operacion" '"Numero_registro_maquina" "Fecha_operacion"
    FldName(6) = "Fecha_operacion" '"Tipo_operacion"
    FldName(7) = "Fecha_operacion"
    FldName(8) = "Observaciones"
    FldName(9) = "Numero_factura_venta"
    FldName(10) = "Base_imponible_venta"
    FldName(11) = "Monto_iva_venta"


    RangeTwo = InputBox("Indique ahora cual es la última operación :", "Rutina XML Seniat")

      MyRow = 5
      LastRow = RangeTwo
       Cells(1, 10).Value = LastRow
       Periodo = Left(Cells(2, 8), 4) & Mid(Cells(2, 8), 6, 2)
      
       For Fila = MyRow To LastRow + 4
          Inicial = 1
          Final = 1
          RIFP = Left(Cells(Fila, 2).Value, 1)
          If RIFP <> "V" And RIFP <> "J" And RIFP <> "G" And RIFP <> "E" And RIFP <> "P" Then
             Switch = 1
             Cells(Fila, 2).Select
             Texta = "Error: Tipo de naturaleza RIF invalido"
             Retorno = ResaltarErrores(Fila, Texta)
          End If
          RIFLargoP = Len(Cells(Fila, 2).Value)
          If RIFLargoP <> 10 Then
             Switch = 1
             Cells(Fila, 2).Select
             Texta = "Error: RIF invalido"
             Retorno = ResaltarErrores(Fila, Texta)
          End If

          If Not IsNumeric(Right(Cells(Fila, 2).Value, 9)) Then
             Switch = 1
             Cells(Fila, 2).Select
             Texta = "Error: RIF no numerico"
             Retorno = ResaltarErrores(Fila, Texta)
          End If
         
          RIFU = Left(Cells(Fila, 4).Value, 1)
          If RIFU <> "V" And RIFU <> "J" And RIFU <> "G" And RIFU <> "E" And RIFU <> "P" Then
             Switch = 1
             Cells(Fila, 4).Select
             Texta = "Error: Tipo de naturaleza RIF invalido"
             Retorno = ResaltarErrores(Fila, Texta)
          End If
          RIFLargoU = Len(Cells(Fila, 4).Value)
          If RIFLargoU <> 10 Then
             Switch = 1
             Cells(Fila, 4).Select
             Texta = "Error: RIF invalido"
             Retorno = ResaltarErrores(Fila, Texta)
          End If

          If Not IsNumeric(Right(Cells(Fila, 4).Value, 9)) Then
             Switch = 1
             Cells(Fila, 4).Select
             Texta = "Error: RIF no numerico"
             Retorno = ResaltarErrores(Fila, Texta)
          End If
         
           ' RIFPT = Left(Cells(Fila, 4).Value, 1) RIF DEL PERSONAL TECNICO
         ' If RIFPT <> "V" And RIFPT <> "J" And RIFPT <> "G" And RIFPT <> "E" And RIFPT <> "P" Then
         '    Switch = 1
         '    Cells(Fila, 4).Select
         '    Texta = "Error: Tipo de naturaleza RIF invalido"
         '    Retorno = ResaltarErrores(Fila, Texta)
         ' End If
         ' RIFLargoPT = Len(Cells(Fila, 4).Value)
         ' If RIFLargoPT <> 10 Then
           '  Switch = 1
          '   Cells(Fila, 4).Select
          '   Texta = "Error: RIF invalido"
          '   Retorno = ResaltarErrores(Fila, Texta)
         ' End If

         ' If Not IsNumeric(Right(Cells(Fila, 4).Value, 9)) Then
          '   Switch = 1
          '   Cells(Fila, 4).Select
          '   Texta = "Error: RIF no numerico"
          '   Retorno = ResaltarErrores(Fila, Texta)
        '  End If
         
           RIFD = Left(Cells(Fila, 3).Value, 1) 'DEBERIA SER EL 5
          If RIFD <> "V" And RIFD <> "J" And RIFD <> "G" And RIFD <> "E" And RIFD <> "P" Then
             Switch = 1
             Cells(Fila, 3).Select
             Texta = "Error: Tipo de naturaleza RIF invalido"
             Retorno = ResaltarErrores(Fila, Texta)
          End If
          RIFLargoD = Len(Cells(Fila, 3).Value)
          If RIFLargoD <> 10 Then
             Switch = 1
             Cells(Fila, 3).Select
             Texta = "Error: RIF invalido"
             Retorno = ResaltarErrores(Fila, Texta)
          End If

          If Not IsNumeric(Right(Cells(Fila, 3).Value, 9)) Then
             Switch = 1
             Cells(Fila, 3).Select
             Texta = "Error: RIF no numerico"
             Retorno = ResaltarErrores(Fila, Texta)
          End If
          
           MAQUINA = Left(Cells(Fila, 5).Value, 3) 'DEBERIA SER 6
          If MAQUINA <> "H3A" And MAQUINA <> "H3B" Then
             Switch = 1
             Cells(Fila, 5).Select
             Texta = "Error: Numero de Identificacion de Maquina Fiscal"
             Retorno = ResaltarErrores(Fila, Texta)
          End If
         
          MAQUINALARGO = Len(Cells(Fila, 5).Value)
          If MAQUINALARGO <> 10 Then
             Switch = 1
             Cells(Fila, 5).Select
             Texta = "Error: Maquina Fiscal invalida"
             Retorno = ResaltarErrores(Fila, Texta)
          End If

          If Not IsNumeric(Right(Cells(Fila, 5).Value, 6)) Then
             Switch = 1
             Cells(Fila, 5).Select ' DE AQUI HACIA ARRIBA ES 7
             Texta = "Error: MAQUINA no numerico"
             Retorno = ResaltarErrores(Fila, Texta)
          End If
         
          Tipo = Len(Cells(Fila, 7).Value) 'DEBERIA SER 7 AGREGANDO EL CAMPO DE RIF TECNICO
          If Tipo <> 2 Then
             Switch = 1
             Cells(Fila, 7).Select
             Texta = "Error: Tipo de Documento invalido"
             Retorno = ResaltarErrores(Fila, Texta)
          End If
       
          If Tipo < "01" Or Tipo > "10" Then
             Switch = 1
             Cells(Fila, 7).Select ' DE AQUI HACIA ARRIBA ES 8
             Texta = "Error: Tipo de Ducumento invalido"
             Retorno = ResaltarErrores(Fila, Texta)
          End If
         
          If Not IsDate(Cells(Fila, 6).Value) Then 'DEBERIA SER 8
                Switch = 1
                Cells(Fila, 6).Select
                Texta = "Error: Tipo de Fecha invalida"
                Retorno = ResaltarErrores(Fila, Texta)
            Else: Cells(Fila, 6).Select
                  Selection.NumberFormat = "yyyy-mm-dd;@"
                  PeriodoElab2 = Right(Cells(Fila, 6), 4) & Mid(Cells(Fila, 6), 4, 2)

                  If PeriodoElab2 > Periodo Then
                     Switch = 1
                     Cells(Fila, 6).Select
                     Texta = "Error: Periodo elaboración invalido"
                     Retorno = ResaltarErrores(Fila, Texta)
                    ElseIf PeriodoElab2 < Periodo Then '200712 Then
                    Switch = 1
                    Cells(Fila, 6).Select ' DE AQUI HACIA ARRIBA ES 9
                    Texta = "Error: Mínimo periodo elaboración invalido"
                    Retorno = ResaltarErrores(Fila, Texta)
                End If
           End If
              
    Next Fila
     
    RIFImprenta = Left(Cells(1, 8).Value, 1)
    If RIFImprenta <> "J" Then  ' Solo se pemite rif de empresas o coperativas
       Switch = 1
       Cells(1, 8).Select
       Texta = "Error: Tipo de naturaleza RIF invalido"
       Retorno = ResaltarErrores(Fila, Texta)
    End If
       
    If Switch <> 1 Then

         If InStr(1, XMLFileName, ":\") = 0 Then
            XMLFileName = DefCarpeta & XMLFileName
         End If

    Open XMLFileName For Output As #1
    Print #1, "<?xml version=" & Chr(34) & "1.0" & Chr(34) & " encoding=" & Chr(34) & "UTF-8" & Chr(34) & "?>"

    ' Print #1, "<" & "Rif_imprenta A=" & Chr(34) & Cells(1, 8).Value & Chr(34); " " & "Periodo_declaracion=" & Chr(34) & Cells(2, 8).Value & Chr(34) & ">"
    ' Print #1, "<" & "Rif_imprenta RIF=" & Chr(34) & Cells(1, 8).Value & Chr(34); " " & "Periodo_declaracion=" & Chr(34) & Cells(2, 8).Value & Chr(34) & ">"

      Print #1, "<" & "Proveedor Periodo_declaracion=" & Chr(34) & Cells(2, 8).Value & Chr(34); " " & "Rif_proveedor=" & Chr(34) & Cells(1, 8).Value & Chr(34) & ">"
      Print #1, "<" & "Distribuidor Rif_distibuidor = " & Chr(34) & Cells(1, 9).Value & Chr(34) & ">"

    For MyRow = 5 To LastRow + 4
     'Print #1, "<" & XMLRecSetName & Chr(34) & ">"
    Print #1, "<" & XMLRecSetName & ">"
    'Print #1, "<" & XMLRecSetName2 & ">"
      For MyCol = 4 To 7 'MODIFICACION DE LAS COLUNMAS QUE APARECE
     
         ' If MyCol = 4 Then Cells(MyRow, MyCol) = Format(Cells(MyRow, MyCol).Value, "yyyy-mm-dd")

         If MyCol = 5 And Cells(MyRow, MyCol).Value = "" Then

            ElseIf MyCol = 9 And Cells(MyRow, MyCol).Value = "" Then

            ElseIf MyCol = 10 And Cells(MyRow, MyCol).Value = "" Then

            ElseIf MyCol = 4 Then Fechin = Format(Cells(MyRow, MyCol).Value, "yyyy-mm-dd")
            Print #1, "<" & FldName(MyCol - 2) & ">" & Fechin & "</" & FldName(MyCol - 2) & ">"
            Else
                Print #1, "<" & FldName(MyCol - 2) & ">" & Cells(MyRow, MyCol).Value & "</" & FldName(MyCol - 2) & ">"
         End If

       Next MyCol
         'Print #1, "<" & FldName(10) & ">" & Cells(MyRow, 22).Value & "</" & FldName(10) & ">"
         'Print #1, "<" & FldName(11) & ">" & Cells(MyRow, 23).Value & "</" & FldName(11) & ">"
       'Print #1, "</" & XMLRecSetName2 & ">"
       Print #1, "</" & XMLRecSetName & ">"
       
     Next MyRow
      Print #1, "</Distribuidor>"
      Print #1, "</Proveedor>"
      Close #1
     
      MsgBox XMLFileName & " created." & MyLF & "Empaquetamiento del XML concluido", vbOKOnly + vbInformation, "Rutina XML Seniat"
      Debug.Print XMLFileName & " saved"
    Else: MsgBox "Por detectarse errores, no se genero el XML"
    End If
    End Sub

    Function FillSpaces(AnyStr As String) As String

    Dim MyPos As Integer
    MyPos = InStr(1, AnyStr, " ")
    Do While MyPos > 0
     Mid(AnyStr, MyPos, 1) = "_"
     MyPos = InStr(1, AnyStr, " ")
    Loop
    FillSpaces = LCase(AnyStr)
    End Function

     

    Function RemoveAmpersands(AnyStr As String) As String

    RemoveAmpersands = AnyStr
    End Function
    Function ResaltarErrores(Filla As Variant, Texto As String)
    ' resaltar errores y enviar mensaje
                With Selection.Interior
                  .ColorIndex = 6
                  .Pattern = xlSolid
                End With
                MsgBox Texto & MyLF _
               
    End Function
    Function FormFech(RowNum As Integer, ColNum As Integer) As String

     FormFech = Cells(RowNum, ColNum).Value
     FormFech = Format(Cells(RowNum, ColNum).Value, "hh:mm")

    End Function

    Pero me dan unos errores super raros de validacion: pero no es al momento de ejecutar la macro sino cuando trato de subir el xml a un portal.

    Dice:

    Atributo periodo_declaracion no esperado

    Atributo rif_proveedor no esperado

    Falta atributo rif_proveedor

    Falta atributo periodo_declaracion

    y como eso errores parecidos, pero todo está declarado, a ver si alguien podría darme una luz a ver que estoy haciendo mal. Pero la estructura del xml esta igual a la que me solicitan.

    Esperando muy agradecida su ayuda me despido cordialmente

    Desde ya muchas gracias.

     

    martes, 7 de mayo de 2013 15:52