MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

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


3 participantes

    [Resolvido]Guardar (Salvar) mensagem (email) numa pasta fora do Outlook

    avatar
    PepeTuga
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 91
    Registrado : 17/10/2013

    [Resolvido]Guardar (Salvar) mensagem (email) numa pasta fora do Outlook Empty [Resolvido]Guardar (Salvar) mensagem (email) numa pasta fora do Outlook

    Mensagem  PepeTuga 29/8/2014, 23:36

    Viva!

    Através deste código VBA consigo abrir e criar mensagem no Outlook:

    Código:
    Private Sub Comando1_Click()
    Dim olApp As Outlook.Application
    Dim olMail As Outlook.MailItem
    Dim objOutlookAttach As Outlook.Attachment

    Set olApp = New Outlook.Application
    Set olMail = olApp.CreateItem(olMailItem)

    With olMail
        .BodyFormat = olFormatHTML
        .ReadReceiptRequested = True
        .Importance = 2
        .To = ""
        .CC = ""
        .Subject = ""
        .Body = ""
        .Save
        .Display
    End With

    Set olMail = Nothing
    Set objOutlookAttach = Nothing
    Set olApp = Nothing
    Set rstAttachments = Nothing
    Set db = Nothing
    End Sub

    Funciona perfeitamente!

    Preciso que a mensagem após enviada seja copiada para uma pasta fora do Outlook.

    Alguém conhece alguma instrução que me possa ajudar?

    Obrigado e conto com as v/as respostas.
    PepeTuga

    PS: Já revirei o fórum e vários sites e nada encontrei sobre este tópico.
    Alvaro Teixeira
    Alvaro Teixeira
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7970
    Registrado : 15/03/2013

    [Resolvido]Guardar (Salvar) mensagem (email) numa pasta fora do Outlook Empty Re: [Resolvido]Guardar (Salvar) mensagem (email) numa pasta fora do Outlook

    Mensagem  Alvaro Teixeira 30/8/2014, 11:46

    Olá, Como assim?
    a) oconteúdo para uma base de dados?
    b) ou guardar em ficheiro tipo EML, HTML?
    Veja se links abaixo ajuda
    http://www.pcreview.co.uk/forums/save-email-msg-file-code-t3867300.html
    http://www.vbaexpress.com/kb/getarticle.php?kb_id=875
    Abraço
    avatar
    PepeTuga
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 91
    Registrado : 17/10/2013

    [Resolvido]Guardar (Salvar) mensagem (email) numa pasta fora do Outlook Empty Re: [Resolvido]Guardar (Salvar) mensagem (email) numa pasta fora do Outlook

    Mensagem  PepeTuga 30/8/2014, 23:35

    Grande Teixeira,

    Sim, pretendo: b) guardar em ficheiro tipo EML, HTML

    Vou dar uma vista de olhos, estudar o material e depois darei retorno.

    Obrigado pela dica!

    Cumps,
    PepeTuga
    avatar
    PepeTuga
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 91
    Registrado : 17/10/2013

    [Resolvido]Guardar (Salvar) mensagem (email) numa pasta fora do Outlook Empty Re: [Resolvido]Guardar (Salvar) mensagem (email) numa pasta fora do Outlook

    Mensagem  PepeTuga 2/9/2014, 17:56

    Amigo Teixeira,

    Já tentei adaptar o módulo que está disponibilizado num dos links que você sugeriu mas está complicado...

    Ele funciona da seguinte forma:
    1. Abre uma seleção de pasta de origem de ficheiros do Outlook;
    2. Depois abre outra seleção de pasta de destino de ficheiros do outlook;
    3. E a cópia é concluída mas da pasta completa.

    Está perfeito mas não é isto que pretendo. Poderá ser utilizado para outros fins.

    O que eu estou a precisar é:
    1. Através do código que indiquei em cima abro uma mensagem Outlook;
    2. Depois de enviada, esta deverá ser copiada para uma pasta de destino fora do outlook (C:\Desktop\MensagensEnviadas\).

    Será que é possível adaptar o módulo abaixo ou criar uma instrução no comando de envio que permita fazê-lo?

    Abraço,
    PepeTuga
    Anexos
    [Resolvido]Guardar (Salvar) mensagem (email) numa pasta fora do Outlook AttachmentModule.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (2 Kb) Baixado 29 vez(es)
    Alvaro Teixeira
    Alvaro Teixeira
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7970
    Registrado : 15/03/2013

    [Resolvido]Guardar (Salvar) mensagem (email) numa pasta fora do Outlook Empty Re: [Resolvido]Guardar (Salvar) mensagem (email) numa pasta fora do Outlook

    Mensagem  Alvaro Teixeira 10/9/2014, 16:50

    Olá Pepe, relativamente à questão através do Access não consigo, no entanto encontrei este código em

    http://www.outlookcode.com/codedetail.aspx?id=2206

    Código:
    '==========================================================================
    'Export Outlook e-mail to drive
    '--------------------------------------------------------------------------
    'Author: Michael Wöhrer
    'Version: 0.2, 2009-01-20
    '==========================================================================
    'Terms and conditions
    '  You can use, redistribute and/or modify this code under the terms of
    '  the SOFTWARE GUIDE LICENSE. This code is distributed in the hope that it
    '  will be useful, but WITHOUT ANY WARRANTY; without even the implied
    '  warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
    '  See the SOFTWARE GUIDE LICENSE for more details.
    '==========================================================================
     
    Option Explicit
     
    '-------------------------------------------------------------
    ' OPTIONS
    '-------------------------------------------------------------
    'Email format:
    ' MSG = Outlook msg format (incl. attachments, embedded objects etc.)., TXT = plain text
    Private Const EXM_OPT_MAILFORMAT As String = "MSG"
    'Date format of filename
    Private Const EXM_OPT_FILENAME_DATEFORMAT As String = "yyyy-mm-dd_hh-nn-ss"
    'Build filename; placeholders: <DATE> for date, <SENDER> for sender's name, <RECEIVER> for receiver, <SUBJECT> for subject
    Private Const EXM_OPT_FILENAME_BUILD As String = "<DATE>_<SUBJECT>"
    'Use browse folder? Set to FALSE if you don't want to use browser for selecting target folder
    Private Const EXM_OPT_USEBROWSER As Boolean = True
    'Target folder (used if EXM_OPT_USEBROWSER is set to FALSE)
    Private Const EXM_OPT_TARGETFOLDER As String = "D:\"
    'Maximum number of emails to be selected & exported. Please don't use a huge number as this will cause
    'performance and maybe other issues. Recommended is a value between 5 and 20.
    Private Const EXM_OPT_MAX_NO As Integer = 10
    'Email subject prefixes (such us "RE:", "FW:" etc.) to be removed. Please note that this is a
    'RegEx expression, google for "regex" for further information. For instance "\s" means blank " ".
    Private Const EXM_OPT_CLEANSUBJECT_REGEX As String = "RE:\s|Re:\s|AW:\s|FW:\s|WG:\s|SV:\s|Antwort:\s"
    '-------------------------------------------------------------
     
     
    '-------------------------------------------------------------
    ' TRANSLATIONS
    '-------------------------------------------------------------
    '-- English
    'Const EXM_007 = "Script terminated"
    'Const EXM_013 = "Selected Outlook item is not an e-mail"
    'Const EXM_014 = "File already exists"
    '-- German
    Private Const EXM_001 As String = "Die E-Mail wurde erfolgreich abgelegt."
    Private Const EXM_002 As String = "Die E-Mail konnte nicht abgelegt werden, Grund:"
    Private Const EXM_003 As String = "Ausgewählter Pfad:"
    Private Const EXM_004 As String = "E-Mail(s) ausgewählt und erfolgreich abgelegt."
    Private Const EXM_005 As String = "<FREE>"
    Private Const EXM_006 As String = "<FREE>"
    Private Const EXM_007 As String = "Script abgebrochen"
    Private Const EXM_008 As String = "Fehler aufgetreten: Sie haben mehr als [LIMIT_SELECTED_ITEMS] E-Mails ausgewählt. Die Aktion wurde beendet."
    Private Const EXM_009 As String = "Es wurde keine E-Mail ausgewählt."
    Private Const EXM_010 As String = "Es ist ein Fehler aufgetreten: es war keine Email im Fokus, so dass die Ablage nicht erfolgen konnte."
    Private Const EXM_011 As String = "Es ist ein Fehler aufgetreten:"
    Private Const EXM_012 As String = "Die Aktion wurde beendet."
    Private Const EXM_013 As String = "Ausgewähltes Outlook-Dokument ist keine E-Mail"
    Private Const EXM_014 As String = "Datei existiert bereits"
    Private Const EXM_015 As String = "<FREE>"
    Private Const EXM_016 As String = "Bitte wählen Sie den Ordner zum Exportieren:"
    Private Const EXM_017 As String = "Fehler beim Exportieren aufgetreten"
    Private Const EXM_018 As String = "Export erfolgreich"
    Private Const EXM_019 As String = "Bei [NO_OF_FAILURES] E-Mail(s) ist ein Fehler aufgetreten:"
    Private Const EXM_020 As String = "[NO_OF_SELECTED_ITEMS] E-Mail(s) wurden ausgewählt und [NO_OF_SUCCESS_ITEMS] E-Mail(s) erfolgreich abgelegt."
    '-------------------------------------------------------------
     
     
    '-------------------------------------
    'For browse folder
    '-------------------------------------
    Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
    Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
    Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
    Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
    Private Const BIF_RETURNONLYFSDIRS = 1
    Private Const MAX_PATH = 260
    Private Type BrowseInfo
     
        hwndOwner As Long
        pIDLRoot As Long
        pszDisplayName As Long
        lpszTitle As Long
        ulFlags As Long
        lpfnCallback As Long
        lParam As Long
        iImage As Long
    End Type
     
    Public Sub ExportEmailToDrive()
       
        Const PROCNAME As String = "ExportEmailToDrive"
       
        On Error GoTo ErrorHandler
       
        Dim myExplorer As Outlook.Explorer
        Dim myfolder As Outlook.MAPIFolder
        Dim myItem As Object
        Dim olSelection As Selection
        Dim strBackupPath As String
        Dim intCountAll As Integer
        Dim intCountFailures As Integer
        Dim strStatusMsg As String
        Dim vSuccess As Variant
        Dim strTemp1 As String
        Dim strTemp2 As String
        Dim strErrorMsg As String
     
        '-------------------------------------
        'Get target drive
        '-------------------------------------
        If (EXM_OPT_USEBROWSER = True) Then
            strBackupPath = GetFileDir
            If Left(strBackupPath, 15) = "ERROR_OCCURRED:" Then
                strErrorMsg = Mid(strBackupPath, 16, 9999)
                Error 5004
            End If
        Else
            strBackupPath = EXM_OPT_TARGETFOLDER
        End If
        If strBackupPath = "" Then GoTo ExitScript
        If (Not Right(strBackupPath, 1) = "\") Then strBackupPath = strBackupPath & "\"
       
       
     
        '-------------------------------------
        'Process according to what is in the focus: an opened e-mail or a folder with selected e-mails.
        'Case 2 would also work for opened e-mail, however it does not always work (for instance if
        ' an e-mail is saved on the file system and being opened from there).
        '-------------------------------------
     
        Set myExplorer = Application.ActiveExplorer
        Set myfolder = myExplorer.CurrentFolder
        If myfolder Is Nothing Then Error 5001
        If Not myfolder.DefaultItemType = olMailItem Then GoTo ExitScript
       
        'Stop if more than x emails selected
        If myExplorer.Selection.Count > EXM_OPT_MAX_NO Then Error 5002
         
        'No email selected at all?
        If myExplorer.Selection.Count = 0 Then Error 5003
         
        Set olSelection = myExplorer.Selection
        intCountAll = 0
        intCountFailures = 0
        For Each myItem In olSelection
            intCountAll = intCountAll + 1
            vSuccess = ProcessEmail(myItem, strBackupPath)
            If (Not vSuccess = True) Then
                Select Case intCountFailures
                    Case 0: strStatusMsg = vSuccess
                    Case 1: strStatusMsg = "1x " & strStatusMsg & Chr(10) & "1x " & vSuccess
                    Case Else: strStatusMsg = strStatusMsg & Chr(10) & "1x " & vSuccess
                End Select
                intCountFailures = intCountFailures + 1
            End If
        Next
        If intCountFailures = 0 Then
            strStatusMsg = intCountAll & " " & EXM_004
        End If
     
           
        'Final Message
        If (intCountFailures = 0) Then  'No failure occurred
            MsgBox strStatusMsg & Chr(10) & Chr(10) & EXM_003 & " " & strBackupPath, 64, EXM_018
        ElseIf (intCountAll = 1) Then  'Only one email was selected and a failure occurred
            MsgBox EXM_002 & Chr(10) & vSuccess & Chr(10) & Chr(10) & EXM_003 & " " & strBackupPath, 48, EXM_017
        Else    'More than one email was selected and at least one failure occurred
            strTemp1 = Replace(EXM_020, "[NO_OF_SELECTED_ITEMS]", intCountAll)
            strTemp1 = Replace(strTemp1, "[NO_OF_SUCCESS_ITEMS]", intCountAll - intCountFailures)
            strTemp2 = Replace(EXM_019, "[NO_OF_FAILURES]", intCountFailures)
            MsgBox strTemp1 & Chr(10) & Chr(10) & strTemp2 & Chr(10) & Chr(10) & strStatusMsg _
            & Chr(10) & Chr(10) & EXM_003 & " " & strBackupPath, 48, EXM_017
        End If
     
     
    ExitScript:
        Exit Sub
    ErrorHandler:
        Select Case Err.Number
        Case 5001:  'Not an email
            MsgBox EXM_010, 64, EXM_007
        Case 5002:
            MsgBox Replace(EXM_008, "[LIMIT_SELECTED_ITEMS]", EXM_OPT_MAX_NO), 64, EXM_007
        Case 5003:
            MsgBox EXM_009, 64, EXM_007
        Case 5004:
            MsgBox EXM_011 & Chr(10) & Chr(10) & strErrorMsg, 48, EXM_007
        Case Else:
            MsgBox EXM_011 & Chr(10) & Chr(10) _
            & Err & " - " & Error$ & Chr(10) & Chr(10) & EXM_012, 48, EXM_007
        End Select
        Resume ExitScript
    End Sub
     
    Private Function ProcessEmail(myItem As Object, strBackupPath As String) As Variant
        'Saves the e-mail on the drive by using the provided path.
        'Returns TRUE if successful, and FALSE otherwise.
     
        Const PROCNAME As String = "ProcessEmail"
     
        On Error GoTo ErrorHandler
     
        Dim myMailItem As MailItem
        Dim strDate As String
        Dim strSender As String
        Dim strReceiver As String
        Dim strSubject As String
        Dim strFinalFileName As String
        Dim strFullPath As String
        Dim vExtConst As Variant
        Dim vTemp As String
        Dim strErrorMsg As String
     
        If TypeOf myItem Is MailItem Then
            Set myMailItem = myItem
        Else
            Error 1001
        End If
     
        'Set filename
        strDate = Format(myMailItem.ReceivedTime, EXM_OPT_FILENAME_DATEFORMAT)
        strSender = myMailItem.SenderName
        strReceiver = myMailItem.To 'All receiver, semikolon separated string
        If InStr(strReceiver, ";") > 0 Then strReceiver = Left(strReceiver, InStr(strReceiver, ";") - 1)
        strSubject = myMailItem.Subject
        strFinalFileName = EXM_OPT_FILENAME_BUILD
        strFinalFileName = Replace(strFinalFileName, "<DATE>", strDate)
        strFinalFileName = Replace(strFinalFileName, "<SENDER>", strSender)
        strFinalFileName = Replace(strFinalFileName, "<RECEIVER>", strReceiver)
        strFinalFileName = Replace(strFinalFileName, "<SUBJECT>", strSubject)
        strFinalFileName = CleanString(strFinalFileName)
        If Left(strFinalFileName, 15) = "ERROR_OCCURRED:" Then
            strErrorMsg = Mid(strFinalFileName, 16, 9999)
            Error 1003
        End If
        strFinalFileName = IIf(Len(strFinalFileName) > 251, Left(strFinalFileName, 251), strFinalFileName)
        strFullPath = strBackupPath & strFinalFileName
       
        'Save as msg or txt?
        Select Case UCase(EXM_OPT_MAILFORMAT)
            Case "MSG":
                strFullPath = strFullPath & ".msg"
                vExtConst = olMSG
            Case Else:
                strFullPath = strFullPath & ".txt"
                vExtConst = olTXT
        End Select
        'File already exists?
        If CreateObject("Scripting.FileSystemObject").FileExists(strFullPath) = True Then
            Error 1002
        End If
       
        'Save file
        myMailItem.SaveAs strFullPath, vExtConst
       
        'Return true as everything was successful
        ProcessEmail = True
     
    ExitScript:
        Exit Function
    ErrorHandler:
        Select Case Err.Number
        Case 1001:  'Not an email
            ProcessEmail = EXM_013
        Case 1002:
            ProcessEmail = EXM_014
        Case 1003:
            ProcessEmail = strErrorMsg
        Case Else:
            ProcessEmail = "Error #" & Err & ": " & Error$ & " (Procedure: " & PROCNAME & ")"
        End Select
        Resume ExitScript
    End Function
     
     
    Private Function CleanString(strData As String) As String
     
        Const PROCNAME As String = "CleanString"
     
        On Error GoTo ErrorHandler
     
        'Instantiate RegEx
        Dim objRegExp As Object
        Set objRegExp = CreateObject("VBScript.RegExp")
        objRegExp.Global = True
     
        'Cut out strings we don't like
        objRegExp.Pattern = EXM_OPT_CLEANSUBJECT_REGEX
        strData = objRegExp.Replace(strData, "")
     
        'Replace and cut out invalid strings.
        strData = Replace(strData, Chr(9), "_")
        strData = Replace(strData, Chr(10), "_")
        strData = Replace(strData, Chr(13), "_")
        objRegExp.Pattern = "[/\\*]"
        strData = objRegExp.Replace(strData, "-")
        objRegExp.Pattern = "[""]"
        strData = objRegExp.Replace(strData, "'")
        objRegExp.Pattern = "[:?<>\|]"
        strData = objRegExp.Replace(strData, "")
       
        'Replace multiple chars by 1 char
        objRegExp.Pattern = "\s+"
        strData = objRegExp.Replace(strData, " ")
        objRegExp.Pattern = "_+"
        strData = objRegExp.Replace(strData, "_")
        objRegExp.Pattern = "-+"
        strData = objRegExp.Replace(strData, "-")
        objRegExp.Pattern = "'+"
        strData = objRegExp.Replace(strData, "'")
               
        'Trim
        strData = Trim(strData)
       
        'Return result
        CleanString = strData
     
     
    ExitScript:
        Exit Function
    ErrorHandler:
        CleanString = "ERROR_OCCURRED:" & "Error #" & Err & ": " & Error$ & " (Procedure: " & PROCNAME & ")"
        Resume ExitScript
    End Function
     
    Private Function GetFileDir() As String
       
        Const PROCNAME As String = "GetFileDir"
     
        On Error GoTo ErrorHandler
     
        Dim ret As String
        Dim lpIDList As Long
        Dim sPath As String
        Dim udtBI As BrowseInfo
        Dim RdStrings() As String
        Dim nNewFiles As Long
     
        'Show a browse-for-folder form:
        With udtBI
            .lpszTitle = lstrcat(EXM_016, "")
            .ulFlags = BIF_RETURNONLYFSDIRS
        End With
     
        lpIDList = SHBrowseForFolder(udtBI)
        If lpIDList = 0 Then Exit Function
           
        'Get the selected folder.
        sPath = String$(MAX_PATH, 0)
        SHGetPathFromIDList lpIDList, sPath
        CoTaskMemFree lpIDList
       
        'Strip Nulls
        If (InStr(sPath, Chr$(0)) > 0) Then sPath = Left$(sPath, InStr(sPath, Chr(0)) - 1)
     
        'Return Dir
        GetFileDir = sPath
     
    ExitScript:
        Exit Function
    ErrorHandler:
        GetFileDir = "ERROR_OCCURRED:" & "Error #" & Err & ": " & Error$ & " (Procedure: " & PROCNAME & ")"
        Resume ExitScript
    End Functio

    Com este código permite efetuar o que pretendes, mas é diretamente do outlook.
    Eu já testei e funciona (as mensagens para utilizador estão em Alemão, mas é so alterar)
    Não sei se algum utilizador aqui do forum poderá adaptar para rolar através do Access.

    Para testar:
    Abre Outlook
    ALT+F11
    Inserir modulo, depois fechar


    Para chamar ALT+F8 e executar a macro ExportEmailToDrive
    Escolher a pasta e está feito.

    Fico aguardar retorno.
    Abraço


    avatar
    PepeTuga
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 91
    Registrado : 17/10/2013

    [Resolvido]Guardar (Salvar) mensagem (email) numa pasta fora do Outlook Empty Re: [Resolvido]Guardar (Salvar) mensagem (email) numa pasta fora do Outlook

    Mensagem  PepeTuga 11/9/2014, 23:47

    Viva!

    Tenho andado às voltas com este tópico e ainda não consegui chegar à solução que pretendo.

    Também andei pesquisando e consegui mais algum material neste site:
    http://translate.google.pt/translate?hl=pt-PT&sl=en&tl=pt&u=http%3A%2F%2Fwww.slipstick.com%2Fdeveloper%2Fcode-samples%2Fsave-selected-message-file%2F&sandbox=1

    Já testei o teu código e com uns pequenos ajustes, que são sugeridos na explicação, os e-mails enviados são guardados diretamente na pasta fora do Outlook. Está melhor mas ainda não serve para o que pretendo...

    Dentro do Outlook, vou tentar adaptar este código para fazer com que esta macro seja executada sempre depois do envio de qualquer mensagem, sendo que a cópia será apenas efetuada caso no Assunto conste, na parte inicial, um texto que é comum às mensagens que pretendo guardar.

    Se por acaso souberes as respetivas instruções ficaria com a solução para o meu dilema sunny.

    Agradeço todo o teu empenho.

    Abraço,
    PepeTuga
    Alvaro Teixeira
    Alvaro Teixeira
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7970
    Registrado : 15/03/2013

    [Resolvido]Guardar (Salvar) mensagem (email) numa pasta fora do Outlook Empty Re: [Resolvido]Guardar (Salvar) mensagem (email) numa pasta fora do Outlook

    Mensagem  Alvaro Teixeira 12/9/2014, 09:40

    Olá, realmente não é fácil.
    O código tanto funciona no Outlook, como também deve funcionar através do Access (acho eu, com alguns ajustes).
    A questão está em ter no access uma caixa de listagem para selecionar as mensagens desejadas.
    Vamos pesquisando...
    Veja mais este http://stackoverflow.com/questions/10248625/find-and-select-an-outlook-email-from-ms-access
    Abraço
    avatar
    PepeTuga
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 91
    Registrado : 17/10/2013

    [Resolvido]Guardar (Salvar) mensagem (email) numa pasta fora do Outlook Empty Re: [Resolvido]Guardar (Salvar) mensagem (email) numa pasta fora do Outlook

    Mensagem  PepeTuga 16/11/2014, 22:58

    Amigo Teixeira,

    Encontrei a solução para o meu problema e através de um passo bastante simples tongue .

    Adicionei ao código inicial a seguinte instrução:
    .SaveAs ("C:\ Desktop\" & Me.NomeFicheiro & Format(Now, "_ddmmyyyyhhnnss") & ".msg")

    Assim sendo, o código final completo é o seguinte:

    Código:
    Private Sub Comando1_Click()
    Dim olApp As Outlook.Application
    Dim olMail As Outlook.MailItem
    Dim objOutlookAttach As Outlook.Attachment

    Set olApp = New Outlook.Application
    Set olMail = olApp.CreateItem(olMailItem)

    With olMail
        .BodyFormat = olFormatHTML
        .ReadReceiptRequested = True
        .Importance = 2
        .To = ""
        .CC = ""
        .Subject = ""
        .Body = ""
        .Save
        .Display
        .SaveAs ("C:\ Desktop\" & Me.NomeFicheiro & Format(Now, "_ddmmyyyyhhnnss") & ".msg")
    End With

    Set olMail = Nothing
    Set objOutlookAttach = Nothing
    Set olApp = Nothing
    Set rstAttachments = Nothing
    Set db = Nothing
    End Sub

    Agradeço todo teu empenho e a ajuda neste tópico.

    Abraço,
    PepeTuga
    Alvaro Teixeira
    Alvaro Teixeira
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7970
    Registrado : 15/03/2013

    [Resolvido]Guardar (Salvar) mensagem (email) numa pasta fora do Outlook Empty Re: [Resolvido]Guardar (Salvar) mensagem (email) numa pasta fora do Outlook

    Mensagem  Alvaro Teixeira 17/11/2014, 09:20

    Olá Pepe, ainda bem que conseguiu.
    Obrigado pelo retorno e partilha da solução, o forúm agradece.
    Abraço cheers
    BrunoReis
    BrunoReis
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 15
    Registrado : 15/08/2022

    [Resolvido]Guardar (Salvar) mensagem (email) numa pasta fora do Outlook Empty Re: [Resolvido]Guardar (Salvar) mensagem (email) numa pasta fora do Outlook

    Mensagem  BrunoReis 13/12/2022, 15:23

    Olá pessoal, olá Pepe!

    Então, testando a solução que você encontrou percebi que ela salva o e-mail e tal, mas isso antes do e-mail ser enviado, tipo um rascunho.

    No meu caso (e, segundo o que entendi da sua primeira mensagem de abertura do tópico, tbm o seu) eu precisava que a mensagem fosse salva após o envio, tipo um "salvar como".
    Pois não bastaria ter o escopo do e-mail salvo, mas sim um link/índice para o e-mail enviado.

    Alguém tem alguma ideia de como?

    Att!

    Conteúdo patrocinado


    [Resolvido]Guardar (Salvar) mensagem (email) numa pasta fora do Outlook Empty Re: [Resolvido]Guardar (Salvar) mensagem (email) numa pasta fora do Outlook

    Mensagem  Conteúdo patrocinado


      Data/hora atual: 3/10/2024, 11:17