none
Converter html para string vba RRS feed

  • Pergunta

  • Prezados,

    Necessito de uma aplicação onde eu informe o html e ele converta em string para VBA, para q eu use referências na planilha para preencher o html de acordo com dados contidos na planilha.

    Colo parte do código q fiz na unha, mas como há modelos de html diferentes teria q construir na unha para cada um e qdo copio e colo no editor VBA me dá certo trabalho encaixar as aspas no lugar certo para chegar no resultado esperado.

    ===============

    Sub str_html()
    Dim texto As String
    texto1 = "<body>" & vbCrLf & _
            " <table width=""383"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""0"">" & vbCrLf & _
            "  <tr>" & vbCrLf & _
            "    <td><table width=""550"" height=""400"" border=""1"" bgcolor=""#FFFFFF"" bordercolor=""#CCCCCC"" align=""center"" cellpadding=""0"" cellspacing=""0"">" & vbCrLf & _
            "     <tr>" & vbCrLf & _
            "        <td valign=""top"" bgcolor=""" & Plan1.Cells(i, 6) & """><table width=""550"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""0"">" & vbCrLf & _
            "         <tr>" & vbCrLf & _
            "            <td width=""550"" height=""13"" valign=""top""><img src=""http://" & Plan1.Cells(i, 5) &"/[RM_IMG_IMAGEM01]"" width=""550"" height=""13"" /></td>" & vbCrLf & _
            "         </tr>" & vbCrLf & _

    ... etc..

    texto2 = texto1 & vbCrLf & _
            "              </tr>" & vbCrLf & _
            "            </table></td>" & vbCrLf & _
            "          </tr>" & vbCrLf & _
            "          <tr>" & vbCrLf & _
            "            <td height=""10"" valign=""top"">&nbsp;</td>" & vbCrLf & _
            "          </tr>" & vbCrLf & _
            "          <tr>" & vbCrLf & _
            "            <td valign=""top""><table width=""550"" border=""0"" cellpadding=""0"" cellspacing=""0"">" & vbCrLf & _
            "              <tr>" & vbCrLf & _
            "                <td width=""35"" rowspan=""2"">&nbsp;</td>" & vbCrLf & _
            "                <td style=""text-align:left; font-family:Calibri, Helvetica, sans-serif; padding- padding-bottom:15px;"">" & vbCrLf & _
            "                    <font style=""color:""" & Plan1.Cells(i, 11) & """; font-size:17px;""><strong>%nome%,</strong></font><br />" & vbCrLf & _
            "                    <font style=""font-size:15px; color:""" & Plan1.Cells(i, 13) & """; line-height:19px;"">" & Plan1.Cells(i, 12) & "</font><br />" & vbCrLf & _
            "                    <font style=""font-size:15px; color:""" & Plan1.Cells(i, 15) & """; line-height:19px;"">" & Plan1.Cells(i, 14) & "</font><br />" & vbCrLf & _
            "                    <font style=""font-size:15px; color:""" & Plan1.Cells(i, 17) & """; line-height:19px;"">" & Plan1.Cells(i, 16) & "</font></td>" & vbCrLf & _
            "              </tr>" & vbCrLf & _

    ==============

    Segue link com uma ideia do que eu gostaria de aplicar, mas não sei como fazer.

    http://blogs.msdn.com/b/joestagner/archive/2008/03/13/utility-to-convert-text-html-to-a-visual-basic-string.aspx

    Grato pessoal,

    Weivisson

    quarta-feira, 13 de janeiro de 2016 14:45

Todas as Respostas

  • Sub getInfoWeb()
    
        Dim xhr As MSXML2.XMLHTTP60
        Dim doc As MSXML2.DOMDocument60
        Dim xmlCell As MSXML2.IXMLDOMElement
        Dim xmlCells As MSXML2.IXMLDOMNodeList
        Dim materialValueElement As MSXML2.IXMLDOMElement
    
        Set xhr = New MSXML2.XMLHTTP60
    
            With xhr
    
                .Open "GET", "http://www.pfconcept.com/cgi-bin/wspd_pcdb_cgi.sh/y/y2productspec-ajax.p?itemc=10031700&_search=false&rows=-1&page=1&sidx=&sord=asc", False
                .send
    
                If .readyState = 4 And .Status = 200 Then
                    Set doc = New MSXML2.DOMDocument60
                    doc.LoadXML .responseText
                Else
                    MsgBox "Error" & vbNewLine & "Ready state: " & .readyState & _
                    vbNewLine & "HTTP request status: " & .Status
                End If
    
            End With
    
            Set xmlCells = doc.getElementsByTagName("cell")
    
            For Each xmlCell In xmlCells
                If xmlCell.Text = "Materiaal" Then
                    Set materialValueElement = xmlCell.NextSibling
                End If
            Next
    
            MsgBox materialValueElement.Text
    
    End Sub

    Por favor, lembre-se de “Marcar como Resposta” as respostas que resolveram o seu problema. Essa é uma maneira comum de reconhecer aqueles que o ajudaram e fazer com que seja mais fácil para os outros visitantes encontrarem a resolução mais tarde.

    • Sugerido como Resposta Erick WendelMVP sábado, 16 de janeiro de 2016 02:14
    sábado, 16 de janeiro de 2016 02:13
  • No final, na MsgBox, da o seguinte erro: "A váriavel do objeto ou bloco With não foi definida".

    Então não consigo ter o retorno para avaliar a aplicação do codigo.

    Sabe o que pode ter ocorrido?

    Grato,

    Weivisson

    segunda-feira, 18 de janeiro de 2016 16:26
  • Achei uma solução simples, que acho q vai atender a necessidade, em : http://www.funbutlearn.com/2012/08/create-instant-html-editor-using-ms.html

    Vide código:

    Private Sub CommandButton1_Click()
    fileNam = Application.GetOpenFilename("HTML Files, *.html, Text Files, *.txt")
    If (fileNam <> False) Then
       Open fileNam For Input As #2
       TextBox1.Text = ""
       While Not EOF(2)
       Line Input #2, readLine
           TextBox1.Text = TextBox1.Text + readLine
       Wend
       Close #2
    End If

    End Sub

    Private Sub CommandButton2_Click()
    fileNam = Application.GetSaveAsFilename()
    If (fileNam <> False) Then
       Open fileNam For Output As #3
       Print #3, TextBox1.Text
       Close #3
    End If
    End Sub

    Private Sub TextBox1_Change()
       WebBrowser1.Navigate ("C:\Windows\Temp\HTMLEditor.html")
       Open "C:\Windows\Temp\HTMLEditor.html" For Output As #1
       Print #1, TextBox1.Text
       Close #1
       WebBrowser1.Refresh
    End Sub

    ===========================================

    Não consigo testar a solução pois na Private Sub TextBox1_Change() retorna a msg de erro: "Erro em tempo de execuçãp 424. O objeto é obrigatório".

    Exatamente na linha WebBrowser1.Navigate ("C:\Windows\Temp\HTMLEditor.html")

    Fucei por aqui e não consegui resolver. Alguém manja o que pode estar ocorrendo?

    Grato,

    Weivisson


    segunda-feira, 18 de janeiro de 2016 18:57
  • Na linha WebBrowser1.Navigate ("C:\Windows\Temp\HTMLEditor.html") , quando vou ao endereço referido o arquivo HTMLEditor.html não existe. Isso é normal?

    Abs.,

    Weivisson

    terça-feira, 19 de janeiro de 2016 17:06