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

    [Resolvido]renomear arquivo

    José
    José
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 118
    Registrado : 14/03/2010

    [Resolvido]renomear arquivo Empty renomear arquivo

    Mensagem  José em 31/10/2011, 22:48

    Prezados, estou utilizando o código de envio de email através do thunderbird gentilmente cedido pelo Sr Vieira e Sr Críquio, porém ao anexar um arquivo, ele dá erro se o nome deste arquivo contiver espaços.

    Por exemplo... se o nome do arquivo for: meu arquivo.txt apresenta erro devido a existir o espaço entre "meu" e "arquivo".

    Existe alguma rotina que retire os espaços antes de anexar o arquivo?

    Grato a todos
    criquio
    criquio
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

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

    [Resolvido]renomear arquivo Empty Re: [Resolvido]renomear arquivo

    Mensagem  criquio em 31/10/2011, 23:36

    Posta aí a função que está usando para vermos melhor. Talvez o Replace resolva:

    varFile = Replace(varFile, " ", "-")


    .................................................................................
    Meu novo site: www.vcssistemas.com.br

    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.

    José
    José
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 118
    Registrado : 14/03/2010

    [Resolvido]renomear arquivo Empty Re: [Resolvido]renomear arquivo

    Mensagem  José em 31/10/2011, 23:53

    O código está neste arquivo ... http://maximoaccess.forumeiros.com/t1095-access-envia-email-pelo-thundermail

    Fiz alguns testes aqui, e o que está causando o erro não é os espaços como havia imaginado, mas os acentos no nome do arquivo.

    José
    José
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 118
    Registrado : 14/03/2010

    [Resolvido]renomear arquivo Empty Re: [Resolvido]renomear arquivo

    Mensagem  José em 31/10/2011, 23:57

    Como estou desenvolvendo este sistema para a empresa onde trabalho, acredito que seja suficiente mostrar uma mensagem para o usuário que não pode ser anexado arquivos que contenham acentos ou espaços.

    Creio que fica mais fácil.

    Como poderia fazer isto?
    criquio
    criquio
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

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

    [Resolvido]renomear arquivo Empty Re: [Resolvido]renomear arquivo

    Mensagem  criquio em 1/11/2011, 00:05

    Amigão, posta a função completa que fica mais fácil para vermos de imediato.


    .................................................................................
    Meu novo site: www.vcssistemas.com.br

    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.

    José
    José
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 118
    Registrado : 14/03/2010

    [Resolvido]renomear arquivo Empty Re: [Resolvido]renomear arquivo

    Mensagem  José em 2/11/2011, 16:54

    Perdoe-me a demora em responder.


    Option Compare Database '....VieiraSoft e Criquio Calavera

    Private Sub B_buscar_arquivo_Click()
    Dim CaminhoFicheiro As String, cont As Integer, temporal As String

    temporal = PedirarquivoTodos()
    If temporal <> "" Then
    CaminhoFicheiro = temporal
    End If

    If Len(CaminhoFicheiro) <> 0 Then
    For cont = 0 To Me.ListaFicheiros.ListCount - 1
    If Me.ListaFicheiros.ItemData(cont) = CaminhoFicheiro Then
    MsgBox "Esse arquivo já se encontra na lista.", , "Aviso"

    Exit Sub
    End If
    Next

    Me.ListaFicheiros.RowSource = Me.ListaFicheiros.RowSource & Trim(CaminhoFicheiro) & ";"
    End If
    End Sub

    Private Sub B_fechar_Click()
    DoCmd.Close
    End Sub

    Private Sub B_Projecto_Click()
    Dim comando As String
    Dim cont As Integer

    comando = DLookup("Caminho", "Caminho_programa")

    comando = comando & " -compose " & Chr(34)

    comando = comando & "to='"
    For cont = 0 To Me.direcções_para.ListCount - 1

    If cont <> Me.direcções_para.ListCount - 1 Then
    comando = comando & Me.direcções_para.ItemData(cont) & ","
    Else
    comando = comando & Me.direcções_para.ItemData(cont)
    End If

    Next
    comando = comando & "',"

    comando = comando & "cc='"
    For cont = 0 To Me.direcções_cc.ListCount - 1

    If cont <> Me.direcções_cc.ListCount - 1 Then
    comando = comando & Me.direcções_cc.ItemData(cont) & ","
    Else
    comando = comando & Me.direcções_cc.ItemData(cont)
    End If

    Next
    comando = comando & "',"

    comando = comando & "bcc='"
    For cont = 0 To Me.direcções_cco.ListCount - 1

    If cont <> Me.direcções_cco.ListCount - 1 Then
    comando = comando & Me.direcções_cco.ItemData(cont) & ","
    Else
    comando = comando & Me.direcções_cco.ItemData(cont)
    End If

    Next
    comando = comando & "',"

    comando = comando & "subject='"
    If Nz(Me.assunto, "") = "" Then
    Else
    comando = comando & Me.assunto
    End If
    comando = comando & "',"

    comando = comando & "body='"
    If Nz(Me.mensagem, "") = "" Then
    Else
    comando = comando & Me.mensagem
    End If
    comando = comando & "',"

    comando = comando & "attachment='"
    For cont = 0 To Me.ListaFicheiros.ListCount - 1

    If cont <> Me.ListaFicheiros.ListCount - 1 Then
    comando = comando & "file://" & Replace_regionais(Me.ListaFicheiros.ItemData(cont)) & ","
    Else
    comando = comando & "file://" & Replace_regionais(Me.ListaFicheiros.ItemData(cont))
    End If

    Next
    comando = comando & "'" & Chr(34)

    Call Shell(comando, vbMinimizedFocus)
    End Sub

    Private Function PedirarquivoTodos()
    Dim fd As New FileDialog

    With fd
    .DialogTitle = "Abrir todos os arquivos (*.*)"

    .DefaultExt = ""

    .Filter1Text = "Todos (*.*)"
    .Filter1Suffix = "*.*"
    .ShowOpen
    End With

    If IsNull(fd.FileName) Then
    PedirarquivoTodos = fd.FileName '""
    Else
    PedirarquivoTodos = fd.FileName
    End If
    End Function

    Private Function Replace_regionais(Ficheiro As String) As String

    Dim strTemporal As String

    strTemporal = Ficheiro

    strTemporal = Replace(strTemporal, "ñ", "%F1")
    strTemporal = Replace(strTemporal, "Ñ", "%D1")

    strTemporal = Replace(strTemporal, "ç", "%E7")
    strTemporal = Replace(strTemporal, "Ç", "%C7")

    strTemporal = Replace(strTemporal, "á", "%E1")
    strTemporal = Replace(strTemporal, "é", "%E9")
    strTemporal = Replace(strTemporal, "í", "%ED")
    strTemporal = Replace(strTemporal, "ó", "%F3")
    strTemporal = Replace(strTemporal, "ú", "%FA")

    strTemporal = Replace(strTemporal, "Á", "%C1")
    strTemporal = Replace(strTemporal, "É", "%C9")
    strTemporal = Replace(strTemporal, "Í", "%CD")
    strTemporal = Replace(strTemporal, "Ó", "%D3")
    strTemporal = Replace(strTemporal, "Ú", "%DA")

    strTemporal = Replace(strTemporal, "à", "%E0")
    strTemporal = Replace(strTemporal, "è", "%E8")
    strTemporal = Replace(strTemporal, "ò", "%F2")

    strTemporal = Replace(strTemporal, "À", "%C0")
    strTemporal = Replace(strTemporal, "È", "%C8")
    strTemporal = Replace(strTemporal, "Ò", "%D2")

    strTemporal = Replace(strTemporal, "ü", "%FC")
    strTemporal = Replace(strTemporal, "Ü", "%DC")

    Replace_regionais = strTemporal

    End Function
    José
    José
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 118
    Registrado : 14/03/2010

    [Resolvido]renomear arquivo Empty Re: [Resolvido]renomear arquivo

    Mensagem  José em 11/11/2011, 19:39

    Embora ainda esteja pendente de solução, vou dar este tópico como resolvido.

    Encontrei este código na internet (não sei o autor), vou fazer um teste e depois comento se funcionou

    Copiar Arquivos e Renomea-los
    Private Sub Copiando_Click()
    On Error GoTo Err_Copiando_Click
    Dim ArquivoDeOrigem, ArquivoDeDestino
    ArquivoDeOrigem = "C:\MeuSistema\BD.mdb" ' Define o nome do arquivo de origem.
    ArquivoDeDestino = "C:\MeuSistema\BD-" & Format(Date, "dddd") & ".mdb"
    'Define o nome do arquivo dedestino.
    FileCopy ArquivoDeOrigem, ArquivoDeDestino ' Copia a origem no destino.
    MsgBox "Arquivo copiado com sucesso", vbInformation, "INFORMAÇÃO"
    Exit_Copiando_Click:
    Exit Sub
    Err_Copiando_Click:
    MsgBox "Ocorreu um erro na operação!", vbCritical, "ERRO"
    Resume Exit_Copiando_Click
    End Sub

      Data/hora atual: 26/9/2020, 23:30