Ayuda con Macro para generar un XML

Question

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.