[Resolvido]renomear arquivo

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

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

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

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.

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?

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

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

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