MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    Retirar Tags Html e Gerar Arquivo txt

    chsestrem
    chsestrem
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 463
    Registrado : 01/03/2010

    Retirar Tags Html  e Gerar Arquivo txt Empty Retirar Tags Html e Gerar Arquivo txt

    Mensagem  chsestrem em 14/2/2011, 12:10

    Função para retirar todas as Tags HTML ou XML
    usando a Classe Microsoft VBScript Regular Expressions 5.5
    Marcar a Referência acima no seu projeto


    '**************************************************************
    ' Importar dados entra as Tags de um arquivo HTML ou XML
    ' By Charles Sestrem chsestrem@bol.com.br
    ' 14/02/2011
    'Usando a Classe Microsoft VBScript Regular Expressions 5.5
    'e gerando um arquivo txt
    'Marcar no seu projeto a Referência acima citada
    '**************************************************************
    Option Compare Database

    Public Function Importa_Xml(CmOrigem As String, CmDestino As String)

    Dim modelo As String
    Dim RegularExpressionObject As Object

    ' Caminho do arquivo xml

    Open CmOrigem For Input As #1
    Set RegularExpressionObject = New VBScript_RegExp_55.RegExp

    Do While Not EOF(1)



    Line Input #1, modelo
    If Len(modelo) > 0 Then
    If Left(modelo, 1) <> "" Then
    Set RegularExpressionObject = New VBScript_RegExp_55.RegExp

    With RegularExpressionObject
    .Pattern = "<[^>]+>"
    .IgnoreCase = True
    .Global = True
    End With

    ' Usando Delimitador " | "
    modelo = RegularExpressionObject.Replace(modelo, "" & " | ")

    ' Pular uma linha a cada TAG
    'modelo = RegularExpressionObject.Replace(modelo, "" & vbCrLf)

    'Caminho do arquivo de saida

    Open CmDestino For Append As #2
    Print #2, modelo
    Close #2
    Set RegularExpressionObject = Nothing
    End If
    End If


    Loop

    Close #1
    End Function

    ' Para Chamar a Função, altere o caminho de origem e de destino:
    ' Call Importa_xml("C:\testexml.xml","C:\testesaida.txt")


    .................................................................................
    Charles Sestrem
    http://www.vbabit.com.br

      Data/hora atual: 29/11/2020, 16:04