[Resolvido]Mensagem Outlook com nome dos anexos no ASSUNTO (Função Loop)

Caros amigos do Fórum,

Estou a precisar da vossa colaboração para me ajudarem neste tópico.

Tenho um código que abre uma mensagem no Outlook preparada para envio já com todos os campos definidos (endereço, ASSUNTO, importância, anexos…).

Está tudo OK mas preciso de um pequeno ajuste no ASSUNTO. Neste necessito também que constem os nomes dos ficheiros em anexo. Ex: “ENVIO DE DOCUMENTOS – ficheiro1.pdf – ficheiro2.pdf”.

Alguém conhece alguma instrução que possibilite este acrescento?

Consigo o nome dos ficheiros disponíveis num subformulário, acontece que para um destinatário poderão estar afetos vários ficheiros e apenas o nome do 1º (que consta na primeira linha) conseguirei incluir no ASSUNTO.

Se conseguisse com que os que pertencem a cada destinatário ficassem na mesma linha teria o meu problema resolvido. Ou seja:
IDFornecedor      NomeFicheiro
12345                ficheiro1.pdf
67890                ficheiro2.pdf – ficheiro3.pdf – ficheiro4.pdf
22222                ficheiro5.pdf – ficheiro6.pdf

Aguardo pelas vossas sugestões.

Abraço,
PepeTuga

Olá Pepe,

O assunto fica à descrição do utilizador ou é automatizado?
Mesmo sendo ambas as situações acho que poderias fazer o seguinte:
O utilizador ao adicionar os anexos, poderias ir adicionando o nome temporário do genero:

AssuntoAnexos = AssuntosAnexos & " - " & nomeFicheiroAdicionado

No final ao enviar adicionavas ao assunto.
Esta solução se o utilizador for eliminar, terás re retirar, podes optar por replace para o caso.
Nota que se for muitos ficheiros anexos é necessário saber o tamanho permitido para Assunto do Outlook.

Outra forma de se poder ajudar é postar aqui o código tens para o teu formulario de envio de mensagens, nem que seja um base de dados com um exemplo funcional.

Abraço

Olá Teixeira!
Sempre no socorro.
Obrigado pelo teu interesse neste tópico.

O ASSUNTO é automatizado e surge já definido na mensagem.

Estava a pensar em fazer um Loop à tabela onde se encontram os nomes dos ficheiros e enviá-los para  uma tabela temporária. Tenho dúvidas é se conseguirei dar instrução para que os nomes dos ficheiros de cada destinatário fiquem apenas numa linha e não em várias como normalmente acontece.

Achas que é viável?

Abraço,
Pepe

Olá, tudo bom.
Sim, a menos que outro colega tenha outra sugestão a solução passa por aí.
Para ajudar, será melhor colocar aí o código que está a fazer essa gestao, já agora é através do outlook, certo?
Ficamos aguardar.
Abraço

Viva!

A instrução é feita por completo no Access.

Passo a descrever em detalhe:
1.º O utilizador gera os anexos e guarda-os dentro de uma pasta, obedecendo a um critério de identificação do ficheiro (Código do destinatário-nome do ficheiro);

2.º De seguida o utilizador, através do VBA abaixo, aciona o processo de envio de anexos, fazendo correr neste passo uma série de procedimentos simultâneos (verificação de existência de anexos na pasta, captação de caminhos dos ficheiros, transferência de dados para tabelas temporárias,…) e a abertura de um formulário com um subformulário. Neste estão contidos os dados de cada destinatário (código, designação, endereço eletrónico,…), sendo aqui que pretendo dispor dos nomes dos anexos para os incluir no assunto das mensagens que são geradas no passo seguinte.

Código:

If Caixa_de_combinação177 = "Enviar Anexos" Then
On Error GoTo PastaInexistente:
Application.DoCmd.SetWarnings False
Dim TheFile As String
Dim Results As String
 
    Dim fso As New FileSystemObject
    Dim result() As String
    Dim Pasta As Folder
    Dim Arquivo As File
    Dim Indice As Long
    ReDim result(0) As String
   
'Verifica se existe ficheiro de importação na pasta de origem
    TheFile = "C: \Envio_Anexos\" & Me.Utilizador & "\*.pdf"""
    Results = Dir$(TheFile)
        'Se não existe
        If Results = "" Then
            MsgBox "Não existem enexos pendentes de envio deste Utilizador!", vbCritical, "Assistente de Atualização!"
            Cancel = True
        'Se existe
        Else
         
    Dim fso1
    Dim strOrigem As String, strDestino As String
    strOrigem = "C:\ Envio_Anexos\" & Me.Utilizador ' caminho de origem da pasta"
    strDestino = "C:\ Envio_Anexos\EATemp\" & Me.Utilizador & "EATemp"  ' caminho de destino"
    Set fso1 = CreateObject("Scripting.FileSystemObject")

    fso1.CopyFolder strOrigem, strDestino
    'MsgBox "Pasta e ficheiros copiados com sucesso !"
   
   
            If fso.FolderExists("C:\Envio_Anexos\EATemp\" & Me.Utilizador & "EATemp") Then
            Set Pasta = fso.GetFolder("C:\Envio_Anexos\EATemp\" & Me.Utilizador & "EATemp")
           
            For Each Arquivo In Pasta.Files
            Indice = IIf(result(0) = "", 0, Indice + 1)
            ReDim Preserve result(Indice) As String
            result(Indice) = Arquivo.Name
       
        Me.Texto291 = result(Indice)
        Me.Texto299 = Me.Utilizador
        Me.Texto302 = strOrigem & "\" & result(Indice)
       
        'Inserir nome do ficheiro e utilizador na tabela
        CurrentDb.Execute "INSERT INTO NE(ID_Destinatario,Utilizador,Caminho) VALUES('" & Me.Texto291 & "','" & Me.Texto299 & "','" & Me.Texto302 & "');"
       
        'Limpar os campos
        Me.Texto291.Undo
        Me.Texto302.Undo
        Next
        Set fso = Nothing
        Set Pasta = Nothing
        Set Arquivo = Nothing
       
        'Transferência de nomes ficheiros para tabela de envio
        DoCmd.OpenQuery "EA_EliminarFicheirosThumbs"
        DoCmd.OpenQuery "EA_EnviarAnexos_Adicionar"
        DoCmd.OpenForm "EA_EnviarAnexos"
       
        End If
       

End If

PastaInexistente:
If Err.Number = 73 Then
MsgBox "Não existe pasta de utilizador definida! Contate o administrador do programa.", vbCritical, "Erro!"
Resume Next
   
End If
End If

End Sub


3.º O utilizador confirma a pretensão de envio, acionando outro botão, que faz surgir as várias mensagens, uma para cada destinatário com os respetivos anexos correspondentes, endereço eletrónico, ASSUNTO, entre outros.

Julgo que a chave para a resolução deste tópico passa por criar uma instrução Loop, para que os nomes passem a constar, de forma corrida dentro do mesmo campo (ex: file1.pdf – file2.pdf – file3.pdf) e correspondente a cada destinatário.

A construção seria mais ou menos esta:
1. Existência de uma tabela (tblNomeFicheiros) com os nomes dos ficheiros, com os campos: ID_Destinatario, NomeFicheiros;

2. Existência de uma tabela temporária (tblNomeFicheiros_Temp) já com os códigos dos destinatários, com os campos: ID_Destinatario, NomeFicheiros;

3. Através do Loop reconhecer na tblNomeFicheiros os códigos do destinatários e copiar os nomes dos ficheiros para a tblNomesFicheiros_Temp, campo NomeFicheiros, em correspondência com os códigos de destinatários também já lá existentes. NOTA: os nomes dos ficheiros pertencentes a cada destinatário apenas deverão apresentar-se no campo único NomeFicheiros.

Precisava de alguma orientação/sugestão na construção deste VBA, é possível ?

Abraço,
Pepe

Olá, não sei se os ficheiros temporarios são só para uma mensagem se for, teste codigo

Código:

If Caixa_de_combinação177 = "Enviar Anexos" Then
On Error GoTo PastaInexistente:
Application.DoCmd.SetWarnings False
Dim TheFile As String
Dim Results As String
  
    Dim fso As New FileSystemObject
    Dim result() As String
    Dim Pasta As Folder
    Dim Arquivo As File
    Dim Indice As Long
    ReDim result(0) As String
    Dim Assunto$ 'ahteixeira
    Assunto = "" 'ahteixeira
    
'Verifica se existe ficheiro de importação na pasta de origem
    TheFile = "C: \Envio_Anexos\" & Me.Utilizador & "\*.pdf"""
    Results = Dir$(TheFile)
        'Se não existe
         If Results = "" Then
            MsgBox "Não existem enexos pendentes de envio deste Utilizador!", vbCritical, "Assistente de Atualização!"
            Cancel = True
         'Se existe
         Else
          
    Dim fso1
    Dim strOrigem As String, strDestino As String
    strOrigem = "C:\ Envio_Anexos\" & Me.Utilizador ' caminho de origem da pasta"
    strDestino = "C:\ Envio_Anexos\EATemp\" & Me.Utilizador & "EATemp"  ' caminho de destino"
    Set fso1 = CreateObject("Scripting.FileSystemObject")

    fso1.CopyFolder strOrigem, strDestino
    'MsgBox "Pasta e ficheiros copiados com sucesso !"
    
    
            If fso.FolderExists("C:\Envio_Anexos\EATemp\" & Me.Utilizador & "EATemp") Then
            Set Pasta = fso.GetFolder("C:\Envio_Anexos\EATemp\" & Me.Utilizador & "EATemp")
            
            For Each Arquivo In Pasta.Files
            Indice = IIf(result(0) = "", 0, Indice + 1)
            ReDim Preserve result(Indice) As String
            result(Indice) = Arquivo.Name
            Assunto = Assunto & IIf(Len(Assunto) <> 0, " - ") & Arquivo.Name 'ahteixeira
        
        Me.Texto291 = result(Indice)
        Me.Texto299 = Me.Utilizador
        Me.Texto302 = strOrigem & "\" & result(Indice)
        
        'Inserir nome do ficheiro e utilizador na tabela
        CurrentDb.Execute "INSERT INTO NE(ID_Destinatario,Utilizador,Caminho) VALUES('" & Me.Texto291 & "','" & Me.Texto299 & "','" & Me.Texto302 & "');"
        
        'ahteixeira teste
        MsgBox Assunto 'ahteixeira
        
        'Limpar os campos
        Me.Texto291.Undo
        Me.Texto302.Undo
        Next
        Set fso = Nothing
        Set Pasta = Nothing
        Set Arquivo = Nothing
        
        'Transferência de nomes ficheiros para tabela de envio
        DoCmd.OpenQuery "EA_EliminarFicheirosThumbs"
        DoCmd.OpenQuery "EA_EnviarAnexos_Adicionar"
        DoCmd.OpenForm "EA_EnviarAnexos"
        
        End If
        

End If

PastaInexistente:
If Err.Number = 73 Then
MsgBox "Não existe pasta de utilizador definida! Contate o administrador do programa.", vbCritical, "Erro!"
Resume Next
    
End If
End If


Estive a ler melhor, teste na mesma, mas caso nao deja o pretendido, poste o codigo do botao que descreveu no 3. Ponto
Abraço

Boas!
Já testei e não funcionou.
Vou aprofundar e depois darei retorno.
Obrigado pela paciência!
Abraço,
Pepe

Olá, da forma que postei (apesar de nao testado) deveria dar a mensagem de todos os ficheiros (se deu algum erro, qual?).
Estive a ler melhor, não estaja a dar o pretendido, poste o codigo do botao que descreveu no 3. Ponto (parece que é aqui que vai criar os emails) e aqui é que será correto.
Talvez seja também bom postar as tabelas que tem o email (criado) e a tabela dos ficheiros anexos (relacionado), poderá ser outra opção uma consulta à tabela criada (loop, no entanto sendo possivel evito sempre as consultas)
Abraço

Olá Teixeira!
Desculpa só agora dar resposta mas é que tenho andado numa fase de muito trabalho e não tem dado para me dedicar a outras coisas.
Eu já identifiquei onde preciso de dispor a informação do assunto para depois o levar, já no formato pretendido, para o e-mail, ou seja, será no subformulário onde tenho listados os destinatários.
Será mais fácil concentrar-mo-nos nesta instrução em isolado do restante código para não complicar.
Assim que possa irei disponibilizar uma BD com o essencial e depois trabalharemos nela.
Grande abraço,
Pepe

Amigo Teixeira (e restantes do Fórum),
Antes de mais, desejo a todos um excelente ano de 2015!

Tenho andado meio desaparecido mas quero trancar este tópico.
Anexo a BD abaixo com o essencial para criação de um Loop no botão do formulário que faça o seguinte:
- Pegar o nome dos ficheiros da tbl_NomeFicheiros e passar para a tbl_FicheirosEnvio nos ID_Destinatarios correspondentes e com os nomes separados por "-". Ou seja,
De:
ID_Destinatario NomeFicheiro
             1111 teste1_1111.pdf
             1111 teste2_1111.pdf
             3333 teste3_3333.pdf
             4444 teste4_4444.pdf
             4444 teste5_4444.pdf
Para:
ID_Destinatario NomeFicheirosTodos
             1111 teste1_1111.pdf-teste2_1111.pdf
             2222
             3333 teste3_3333.pdf
             4444 teste4_4444.pdf-teste5_4444.pdf

Tendo esta instrução consigo finalizar o projeto. Conto com a tua (vossa) ajuda...

Obrigado e grande abraço,
Pepe

Olá Pepe, obrigado e também retribuo com tudo de bom para 2015.
Relativamente à questão, segue abaixo código é só inserir no ficheiro postado.

Código:

Private Sub Comando0_Click()
Dim db As Database, RS As Recordset
Dim strSQL As String, idDest%, filesDest$

Set db = CurrentDb
strSQL = "SELECT tbl_NomeFicheiros.ID_Destinatario, tbl_NomeFicheiros.NomeFicheiro FROM tbl_NomeFicheiros ORDER BY tbl_NomeFicheiros.ID_Destinatario;"
Set RS = db.OpenRecordset(strSQL)

       DoCmd.RunSQL "Delete * from tbl_FicheirosEnvio"  ' Limpar

       With RS
        idDest = RS.Fields(0)
        files = RS.Fields(1)
  
          Do While Not .EOF
              If RS.Fields(0) = idDest Then
                  filesDest = IIf(Len(filesDest) = 0, RS.Fields(1), filesDest & "-" & RS.Fields(1))
              Else
                  DoCmd.RunSQL "INSERT INTO tbl_FicheirosEnvio ( ID_Destinatario, NomeFicheirosTodos ) SELECT " & idDest & ", '" & filesDest & "';"
                  DoEvents
                  idDest = RS.Fields(0)
                  filesDest = RS.Fields(1)
              End If
             .MoveNext
            
             If .EOF Then DoCmd.RunSQL "INSERT INTO tbl_FicheirosEnvio ( ID_Destinatario, NomeFicheirosTodos ) SELECT " & idDest & ", '" & filesDest & "';"
          Loop
  
       End With
    
RS.Close
db.Close
MsgBox "feito"
End Sub


Na minha opinião esta funcional para o que pretende, foi um pouco a correr, no entanto sera melhor uns ajustes, caso nao tenha ficheiros a processar deve dar erro.
Abraço

Grande Teixeira!
Testei e funcionou muito bem!
Irei adaptar ao resto do código e acho que ficará completo.
Depois darei notícias.
Obrigado pela sua preciosa ajuda!
Abraço,
Pepe

PS: Alterei o título do tópico para ficar também disponível na busca por "Loop".

Olá, mais uma sugestão, testa o código com vários ficheiros de forma a passar os 255 carateres, também não sei o limite para o assunto de uma mensagem do outlook.
Qualquer coisa, cá estamos. Obrigado pelo retorno.
Abraço