MaximoAccess

Caro Usuário, não tire as suas duvidas nas Salas de Repositório, abra sempre um novo tópico relacionado, nas salas destinadas para o efeito, como Sala de Tabelas, Consultas, Formulários, Relatórios, Macros, Módulos e VBA.

Obrigado

Administração do MaximoAccess

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

    FileSystemObject problemas com caracteres

    Compartilhe

    madsonbraz
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 4
    Registrado : 28/05/2010

    FileSystemObject problemas com caracteres

    Mensagem  madsonbraz em Sex 07 Fev 2014, 19:31

    Prezad@s,

    Estou tendo um problema com um codigo que utilizo para editar um arquivo html. Explico:

    Tenho arquivo template HTML, onde criei algumas tags(Ex.: [PERIODO], [LOCAL], etc.)  que utilizo para mesclar textos para envio de e-mail.

    Acontece que os caracteres acentuados estão sendo exibidos de forma truncada, mesmo eu alterado o DOCTYPE ou o charset do html.

    Acredito o problema esteja na hora da escrito, pois se escrevo no html, utilizando o notepad por exemplo, os caracteres acentuados são exibidos corretamente.

    Para efetuar a alteração no conteúdo do arquivo, utilizo o código abaixo:

    Public Function ReplaceTextEmailTurma(idinscricao As Integer, Turma As Integer, emissor As String) As String
       Dim fSys
       'create outside recursion and pass in, this is more memory efficient
       
       Set fSys = CreateObject("Scripting.FileSystemObject")
       Dim arq As String
       Dim diretorio As String
       Dim sqlHtml As String
       Dim rsCrt As Recordset
       Dim assinatura As String
       
       sqlHtml = "select * from qryDadosEmailTurma where ins_idinscricao=" & idinscricao & " and idturma=" & Turma
     
       Set rsCrt = CurrentDb.OpenRecordset(sqlHtml)
       rsCrt.MoveLast
       rsCrt.MoveFirst
       
       assinatura = DLookup("[usr_email_ass]", "phy_users", "[usr_nome]='" & emissor & "'")
       
       arq = rsCrt!NomeTurma & "-" & rsCrt!dac_NOME & ".html"
       
     
       fSys.CopyFile CaminhoArq("DocsSystem") & "\emailTemplate.html", CaminhoArq("DocsSystem") & "\EmailTurma\" & arq
       'Replace_Text(CaminhoArq("DocsSystem") & "\EmailTurma", arq, "", "", "", rsCrt!DAC_NOMECRACA, fSys, corpo
       
       Dim targetFile As String
       Dim targetText As String
       Dim replaceText As String
       Dim fileSys As Variant
       Dim root As String
       Dim rootdir
       Dim rootFiles
       Dim File
       
       
       Dim PrimeiroNom As String
       Dim Period As String
       Dim Etap As String
       Dim curs As String
       Dim Cidad As String
       Dim horari As String
       Dim LOCA As String
       Dim LOC_END As String
       
       
       Set rootdir = fSys.GetFolder(CaminhoArq("DocsSystem") & "\EmailTurma")
       
       Set rootFiles = rootdir.Files
       For Each File In rootFiles
           If File.Name = arq Then
               'Debug.Print file.Path
               'replace the text in the file
               PrimeiroNom = InicialMaiuscula(rsCrt!DAC_NOMECRACA)
               Period = Periodo(rsCrt!inicio, rsCrt!fim)
               Etap = UCase(rsCrt!Etapa)
               curs = UCase(rsCrt!curso)
               Cidad = UCase(rsCrt!CidadeCurso)
               horari = horario(rsCrt!inicio, rsCrt!fim)
               LOC_END = "

    " & rsCrt!loc_Endereco & " - " & rsCrt!loc_bairro & "
    " & rsCrt!CidadeLocal & "/" & rsCrt!LocalUF & " - CEP " & rsCrt!loc_cep & "
    " & rsCrt!loc_telefone & "

    "
               
               Update_File File.path, "[PRIMEIRONOME]", PrimeiroNom, fSys
               Update_File File.path, "[PERIODO]", Period, fSys
               Update_File File.path, "[ETAPA]", Etap, fSys
               Update_File File.path, "[CURSO]", curs, fSys
               Update_File File.path, "[CIDADE]", Cidad, fSys
               Update_File File.path, "[HORARIO]", horari, fSys
               
               If rsCrt!TipoLocal = "CT" Then
                    LOCA = "

    CENTRO DE TREINAMENTO  - " & rsCrt!CidadeLocal & "
    " & UCase(rsCrt!loc_Local) & "

    "
               ElseIf rsCrt!TipoLocal = "SP" Then
                    LOCA = "

    STUDIO PREFERENCIAL  - " & UCase(rsCrt!CidadeLocal) & "
    " & UCase(rsCrt!loc_Local) & "

    "
               Else
                    LOCA = "

    " & rsCrt!loc_Local & "/

    "
               End If
               Update_File File.path, "[LOCAL]", LOCA, fSys
               Update_File File.path, "[LOC_ENDERECO]", LOC_END, fSys
               Update_File File.path, "[ASSINATURA]", assinatura, fSys
               
           End If
           'uncomment this to see all the files that are checked
           'Debug.Print file.Path
       Next
           
       ReplaceTextEmailTurma = arq
    End Function


    Sub Update_File(fileToUpdate As String, targetText As String, replaceText As String, fileSys As Variant)
       'creates a temp file and outputs the original files contents but with the replacements
       Dim tempName
       Dim tempFile
       Dim File
       Dim currentLine
       Dim newLine
       tempName = fileToUpdate & ".tmp"
       Set tempFile = fileSys.CreateTextFile(tempName, True, False)
       
       'open the original file and for each line replace any matching text
       Set File = fileSys.OpenTextFile(fileToUpdate)
       Do Until File.AtEndOfStream
           currentLine = File.ReadLine
           newLine = Replace(currentLine, targetText, replaceText)
           'write to the new line containing replacements to the temp file
           tempFile.WriteLine newLine
       Loop
       File.Close
       
       tempFile.Close
       
       'delete the original file and replace with the temporary file
       fileSys.DeleteFile fileToUpdate, True
       fileSys.MoveFile tempName, fileToUpdate
    End Sub
    Anexos
    KRISTINA.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (2 Kb) Baixado 1 vez(es)

    criquio
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 11229
    Registrado : 30/12/2009

    Re: FileSystemObject problemas com caracteres

    Mensagem  criquio em Sex 07 Fev 2014, 20:21

    Só para testar, tente usar a codificação HTML de acentos. Exemplo:

    Código:
    Dim Frase As String
    Frase = "Amanhã vou lá hoje."

    Frase = Replace(Replace(Frase, "ã", "& atilde; "), "á", "& aacute ;")

    Sem os espaços que coloquei para poder enviar certo.


    .................................................................................
    Meu novo site: [Você precisa estar registrado e conectado para ver este link.]

    Clique aqui e veja um vídeo que explica como fazer pesquisas no forum.


    DICA: Quando precisar inserir um exemplo do seu aplicativo, siga os procedimentos abaixo:
    1 - faça uma cópia do aplicativo
    2 - retire tudo que não for necessário à solução do problema, exceto o que o aplicativo precisar para funcionar
    3 - use o Compactar/Reparar
    4 - compacte o aplicativo em zip ou rar (zip para postagem como anexo na mensagem)


    Agradeça a quem lhe ajudou, clicando no joinha de uma das mensagens do usuário.
    Positive as mensagens que achar útil, no canto superior direito delas.


      Data/hora atual: Dom 11 Dez 2016, 00:19