inviare documento attivo ad email con macro

[cla.ghe]

Salve a tutti,
ho un documento word che vorrei inviare al termine della compilazione, mediante una macro, come allegato ad un email "pippo@pippo.it" ed eventualmente anche ad altri (vedi opzione invia a destinatario di posta come allegato dal menù file).

Se lo mandassi da casa userei Tiscali, se lo mandassi dall'ufficio userei Lotus Notes; cambia qualcosa da specificare nel listato della macro o da qualche altra parte ?

Scusate la mia ignoranza, ma potreste aiutarmi?
Grazie!

[Flash30005]

Se clicchi su un indirizzo di email pippo@pippo.it da qualsasi computer e con qualsiasi programma di messaggistica si aprirà sempre il programma collegato agli indirizzi email quindi in linea generale non cambia nulla per il resto dipende da come si realizza la macro

Se navighi in alcuni post, facendo una ricerca, troverai delle soluzioni: proprio ultimamente è stato risolto questo quesito.

Ciao

[cla.ghe]

Ti ringrazio per la sollecita risposta, ma se in excel mi basta scrivere:

Sub INVIAEMAIL()
'
' INVIAEMAIL Macro
' Macro registrata il 18/12/2009 da Claudio
'
Destin = "cla.ghe@tiscali.it"
ActiveWorkbook.SendMail Recipients:=Destin, Subject:="Ciao"
'
End Sub

in word non ho proprio idea di cosa usare.

Potresti indicarmi quale listato usare ed indicarmi dove trovare la soluzione che mi dici di essere già stata pubblicata?

Grazie ancora.

[Flash30005]

Questo è il link
http://www.pc-facile.com/forum/viewtopic.php?f=26&t=62073&p=476450&hilit=+email#p476450
e la macro è questa (funziona con Outlook mentre con Outlook Express bisogna ricorre a sotterfugi):

Codice: Seleziona tutto

Sub Invioemail()
Dim OutApp As Object
Dim OutMail As Object
Dim EmailAddr As String
Dim Subj As String
Dim BodyText As String

EmailAddr = "email@email.com"  '<<< inserire lo/gli indirizzi
Subj = "Saluti"

BodyText = "Ciao"

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With OutMail
.to = EmailAddr
.CC = ""
.BCC = ""
.Subject = Subj
.body = BodyText
.send
End With

Set OutMail = Nothing
Set OutApp = Nothing
End Sub


Ciao

[cla.ghe]

Il contenuto del link che mi hai nviato l'avevo già esaminato e mi sembrava riservato ad EXCEL

Scusa la mia ignoranza in materia ma, dopo averti in ogni caso ringraziato, vorrei precisare quanto segue:

-il documento da inviare come allegato è un file di WORD che vorrei se posssibile non inviare con OUTLOOK ma tramite TISCALI o LOTUS NOTES ad esempio, pertanto il listato che mi hai gentilmente inviato come dovrebbe essere modificato?

Grazie ancora e Ciao.

[Anthony47]

Vba e' integrato con Outlook per la compilazione anche del testo; altri client di posta (es Lotus Notes, Outlook Express) possono essere attivati e predisposti all' invio del documento come allegato (tramite Application.Dialogs(xlDialogSendMail).Show) , ma rimangono altre operazioni da fare a mano, es scrivere il testo.

Ciao.

[Flash30005]

Questa macro la uso da access (il VBA è lo stesso di Word), invia l'email con Lotus Notes e allega un file sul disco,
l'ho modificata per le tue esigenze ma non l'ho potuta testare

Codice: Seleziona tutto

Private Sub SendLotus()
    Dim Maildb As Object
    Dim UserName As String
    Dim MailDbName As String
    Dim MailDoc As Object
    Dim AttachME As Object
    Dim Session As Object
    Dim EmbedObj As Object
    Set Session = CreateObject("Notes.NotesSession")
    UserName = Session.UserName
    MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
    Set Maildb = Session.GETDATABASE("", MailDbName)
     If Maildb.IsOpen = True Then
     Else
         Maildb.OPENMAIL
     End If
     
DestA1 = "Nome.Cognome@gestore.it, Nome2.Cognome2@gestore2.com" ' per più destinatari inserire "," + spazio + nuovo indirizzo (come da esempio)
DestA2 = "Nome.Cognome@gestore.it"  'oppure = ""
DestA3 = "Nome.Cognome@gestore.it" 'oppure = ""

DestinTO = DestA1
DestinCC = DestA2
DestinCN = DestA3
Dim Recipient, EnterSendTo As String
Recipient = DestinTO
Set MailDoc = Maildb.CREATEDOCUMENT
    MailDoc.Form = "Memo"
    MailDoc.SendTo = Recipient
    MailDoc.CopyTo = DestinCC
    MailDoc.BlindCopyTo = DestinCN
    EnterSendTo = Recipient
    MailDoc.Subject = "Scrivero Oggetto"
    MailDoc.Body = "Corpo dell'email"
    MailDoc.SAVEMESSAGEONSEND = True
    attachment = "C:\Cartella\File.doc" 'allegato
    If attachment <> "" Then
        Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
        Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", attachment, "Attachment")
    End If
    MailDoc.SEND 0, Recipient
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set AttachME = Nothing
    Set Session = Nothing
    Set EmbedObj = Nothing
End Sub

Prova e fai sapere
Ciao

[cla.ghe]

Come sempre solerti risposte ma forse non ti rendi conto della mia ignoranza in materia pertanto ti chiederei da quale testo/i potrei cominciare per cercare di capire qualcosain merito.

Nel frattempo però avendo urgenza di risolvere il problema ti sarei grado se mi potessi inviare il listato completo relativo alla mia richiesta.

Grazie ancora e tanti auguri e complimenti.

[cla.ghe]

Mi scuso ma non avevo visto la risposta che mi avevi inviato e la mia precedente richiesta era riferita al contributo di Anthony47.

In tutta sincerità qualche commento riga per riga in più al tuo listato di ACCESS adattato non guasterebbe, specialmente per gente come me.

Rimane valida la richiesta di suggerimento di un testo valido per neofiti.

Cercherò di provare il tuo listato, se ci riesco, e farò sapere.

Ciao

[cla.ghe]

OK, da sola la macro che mi hai inviato funziona, ma lanciandola dalla macro principale quando arriva a:

Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", attachment, "Attachment")

va in errore di runtime '7225: File C:\...........\valorecella not found, dove "valorecella" nella macro principale è una variabile che contiene il nome del file, peraltro prelevato da un foglio di Excel, con il quale voglio nominare il file creato e da inviare via email.

Spero di essere stato chiaro e in ogni caso potrei inviarti se necessario tutto il listato delle macro.

Grazie ancora e ciao.

[Flash30005]

Non ho la possibilità di provare la macro perché qui non ho Lotus Notes quindi, non credo siano, al momento, utili le tue macro.
Ma non capisco questo valore cella in quella riga di codice (stiamo lavorando in word o excel?),
Fai così (anche solo per prova):
metti un file.doc in una cartella di C:\ o direttamente nella Root,
inserisci nella macro il percorso effettivo di quel file C:\file.doc (o altro ma che sia reale) poi avvia la macro
poi semmai farai i dovuti aggiustamenti...

Fai sapere
ciao

[cla.ghe]

Anche se non hai la possibilità di provare la macro perché non hai Lotus Notes per cercare di capire meglio ti allego comunque le macro.

Preciso che lavoro in WORD anche se inizialmente vado a leggere il contenuto di una cella di un foglio di excel e ne assegno il valore ad una variabile chiamata "valorecella"; questa variabile individua il file che una volta archiviato, come tu suggerisci in C:\file.doc, dovrebbe essere utilizzato dalla Sub SendLotus per l’invio come allegato alla posta. (se metto C:\nome del file.doc funziona se metto C:\valorecella (che è uguale a nome del file.doc )non funziona ).

Codice: Seleziona tutto

Public valorecella As String
Public DestA1 As String
Public DestA2 As String

Sub SALVACONNOME()
'
' SALVACONNOME Macro
' Macro registrata il 03/12/2009 da Claudio
'
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim xlrange As Excel.Range
   
   
   
  'Sub Importa()
  'Dichiaro le variabili locali
  Dim valorecella As String
  Dim i As Integer
  'Creo la nuova applicazione
  Set xlApp = New Excel.Application
  'Attraverso la nuova applicazione apro il Workbook
  'assegnandolo alla variabile oggetto xlBook
  Set xlBook = xlApp.Workbooks.Open("C:\.......\.........\........\......\ImportaExcel2.xls")
  'Decido quale foglio utilizzare
  Set xlSheet = xlBook.Worksheets("Foglio1")

 
        valorecella = ActiveCell 'assegno alla variabile "valorecella" il contenuto della cella attiva del foglio1 di excel       

ChangeFileOpenDirectory " C:\.......\.........\........\......\ARCHIVIOGENERALE"

        ActiveDocument.SaveAs FileName:=valorecella, FileFormat:=wdFormatDocument, LockComments:=False, Password:="", _
        AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
        EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
        :=False, SaveAsAOCELetter:=False

'’’’’’’’’’’’’’’archiviare/inviare a cgherardi@tiscali.it ‘’’’’’’’’’’’’’

irisposta = MsgBox("YES per inviare a cgherardi@tiscali.it / NO per continuare senza inviare", vbYesNo)
        If irisposta = vbYes Then

‘prima di inviare salvo il file col nome contenuto nella variabile “valorecella” nel percorso che segue

            ChangeFileOpenDirectory " C:\.......\.........\........\......\CGHERARDI"

            ActiveDocument.SaveAs FileName:=valorecella, FileFormat:=wdFormatDocument, LockComments:=False, Password:="", _
            AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
            EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
            :=False, SaveAsAOCELetter:=False

        DestA1 = "cla.ghe@tiscali.it" ' per più destinatari inserire "," + spazio + nuovo indirizzo (come da esempio)

SendLotus 'mi sposto sull’applicazione SendLotus

        End If

'’’’’’’’’’’’’’’archiviare/inviare a ppluto@tiscali.it ‘’’’’’’’’’’’’’

irisposta = MsgBox("YES per inviare a ppluto@tiscali.it / NO per continuare senza inviare", vbYesNo)
        If irisposta = vbYes Then

‘prima di inviare salvo il file col nome contenuto nella variabile “valorecella” nel percorso che segue

            ChangeFileOpenDirectory " C:\.......\.........\........\......\PPLUTO"

            ActiveDocument.SaveAs FileName:=valorecella, FileFormat:=wdFormatDocument, LockComments:=False, Password:="", _
            AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
            EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
            :=False, SaveAsAOCELetter:=False

        DestA2 = "ppluto@tiscali.it" ' per più destinatari inserire "," + spazio + nuovo indirizzo (come da esempio)

SendLotus 'mi sposto sull’applicazione SendLotus

        End If
       
        apredocbase ' apre un nuovo documento base
 
'ActiveWorkbook.Save
  'Chiudo il Workbook e l'Applicazione
  xlBook.Close (False)
  xlApp.Quit
  'Annullo le variabili per liberare le risorse
  Set xlSheet = Nothing
  Set xlBook = Nothing
  Set xlApp = Nothing
       
        Windows(valorecella).Activate 'attivo il documento appena salvato
        ActiveDocument.Close ' e lo chiudo
                                       

End Sub

‘**************************************************



Sub SendLotus()


'Private Sub SendLotus()
    Dim Maildb As Object
    Dim UserName As String
    Dim MailDbName As String
    Dim MailDoc As Object
    Dim AttachME As Object
    Dim Session As Object
    Dim EmbedObj As Object
    Set Session = CreateObject("Notes.NotesSession")
    UserName = Session.UserName
    MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
    Set Maildb = Session.GETDATABASE("", MailDbName)
     If Maildb.IsOpen = True Then
     Else
         Maildb.OPENMAIL
    End If
     

'DestA1 = "Nome.Cognome@gestore.it, Nome2.Cognome2@gestore2.com" ' per più destinatari inserire "," + spazio + nuovo indirizzo (come da esempio)
'DestA2 = "Nome.Cognome@gestore.it"  'oppure = ""
'DestA3 = "Nome.Cognome@gestore.it" 'oppure = ""

DestinTO = DestA1, DestA2
‘DestinCC = DestA2
‘DestinCN = DestA3
Dim Recipient, EnterSendTo As String
Recipient = DestinTO
Set MailDoc = Maildb.CREATEDOCUMENT
    MailDoc.Form = "Memo"
    MailDoc.SendTo = Recipient
    MailDoc.CopyTo = DestinCC
    MailDoc.BlindCopyTo = DestinCN
    EnterSendTo = Recipient
    MailDoc.Subject = "Trasmissione verbale"
    MailDoc.Body = "Corpo dell'email"
    MailDoc.SAVEMESSAGEONSEND = True
   
      attachment = " C:\.......\.........\........\......\ valorecella" 'allegato
 
    If attachment <> "" Then
        Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
        Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", attachment, "Attachment")
    End If
    MailDoc.SEND 0, Recipient
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set AttachME = Nothing
    Set Session = Nothing
    Set EmbedObj = Nothing
End Sub



Ciao e grazie ancora.

[Flash30005]

Beh! Dipende da cosa ci metti nel "ValoreCella"

In word potresti usare un codice che richiama l'applicazione excel, poi il file e poi il valorecella, esempio

Codice: Seleziona tutto

Sub DatiExcel()
Dim oApp As Object
percorso = "C:\Documenti\"
OutFile = "C:\Documenti\Prova.xls"
nomefile = "Prova.xls"
foglio = "Foglio1"
rif = "$A$4"
Set oApp = CreateObject("Excel.Application")
    oApp.Visible = True
    oApp.Workbooks.Open FileName:=(OutFile)
    oApp.ActiveWindow.Visible = True
    arg = "'" & percorso & "[" & nomefile & "]" & foglio & "'!" & oApp.Range(rif).Range("A1").Address(, , xlR1C1)
FileInvio = oApp.ExecuteExcel4Macro(arg)
oApp.Workbooks(nomefile).Close SaveChanges:=False

MsgBox FileInvio
End Sub

Il "Fileinvio" è la variabile con il percorso e file che devi mettere nella macro
(chiaramente togli l'Msgbox)

Prova e fai sapere

Ciao

[cla.ghe]

Ho risolto il problema comportandomi così in Sub SendLotus:

Codice: Seleziona tutto

     
..........
valorecella = activedocument
attachment = " C:\.......\.........\........\......\" & valorecella" 'allegato
..........


e adesso riconosce la variabile valorecella

Grazie di tutto e tanti auguri di Buon Anno.

[cla.ghe]

Scusate ma col copia e incolla mi sono rimaste due " di troppo; ecco la versione corretta:


..........
valorecella = activedocument
attachment = " C:\.......\.........\........\......\" & valorecella 'allegato
..........

Buon anno.