Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

Macro excel per compilare campi email

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Macro excel per compilare campi email

Postdi BG66 » 08/10/17 11:15

Ciao,
in realtà il titolo di questo thread poteva essere: "Mi manda Mozilla" :P
Immagine
In breve:
vorrei che quando si apre thunderbird oltre ad allegare il foglio di lavoro (cosa che già fà), mi compilasse anche i campi destinatario, oggetto e testo prendendoli da celle definite.
Pensavo di riuscirci inserendo queste istruzioni specifiche:

Codice: Seleziona tutto
Dim BodyMsg As String 'mio inserimento
    Dim Indirizzo As String 'mio inserimento
    Dim Oggetto As String 'mio inserimento
     ....
    BodyMsg = Range("Foglio1!K6").Value 'mio inserimento
    Indirizzo = Range("Foglio1!K2").Value 'mio inserimento
    Oggetto = Range("Foglio1!K4").Value 'mio inserimento


Ma non ottengo nessun risultato.

La macro completa è la seguente:
Codice: Seleziona tutto
Sub Invia_ActiveSheet()
'Working in 97-2010
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim I As Long
    Dim BodyMsg As String 'mio inserimento
    Dim Indirizzo As String 'mio inserimento
    Dim Oggetto As String 'mio inserimento
   
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
   
    BodyMsg = Range("Foglio1!K6").Value 'mio inserimento
    Indirizzo = Range("Foglio1!K2").Value 'mio inserimento
    Oggetto = Range("Foglio1!K4").Value 'mio inserimento
   
    Set Sourcewb = ActiveWorkbook

    'Copy the sheet to a new workbook
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook
   
    'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007-2010, we exit the sub when your answer is
            'NO in the security dialog that you only see  when you copy
            'an sheet from a xlsm file with macro's disabled.
            If Sourcewb.Name = .Name Then
                With Application
                    .ScreenUpdating = True
                    .EnableEvents = True
                End With
                MsgBox "Your answer is NO in the security dialog"
                Exit Sub
            Else
                Select Case Sourcewb.FileFormat
                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56: FileExtStr = ".xls": FileFormatNum = 56
                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select
            End If
        End If
    End With

   'Save the new workbook/Mail it/Delete it
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Part of " & Sourcewb.Name & " " _
                 & Format(Now, "dd-mmm-yy h-mm-ss")

    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                FileFormat:=FileFormatNum
        On Error Resume Next
        For I = 1 To 3
            .SendMail "", _
                      ""
            If Err.Number = 0 Then Exit For
        Next I
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

    'Delete the file you have send
    Kill TempFilePath & TempFileName & FileExtStr

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub


https://www.dropbox.com/s/tuso166ta9rbxic/prova_invioPDF%26Foglio.xlsm?dl=0

Grazie in anticipo
BG66
Excel2010
Avatar utente
BG66
Utente Senior
 
Post: 261
Iscritto il: 20/08/16 07:44

Sponsor
 

Re: Macro excel per compilare campi email

Postdi FRIEDRICH » 08/10/17 19:45

Ciao BG66,

prova con il codice seguente:

Codice: Seleziona tutto
Option Explicit

Sub Invia_ActiveSheet2()
'Working in 97-2010
   
    Dim FileExtStr, TempFilePath, TempFileName, InviaMail, MiaMail, Indirizzo, Oggetto, BodyMsg, Allegato As String
    Dim FileFormatNum As Long
    Dim Sourcewb, Destwb As Workbook
   
    BodyMsg = Range("Foglio1!K6").Value 'mio inserimento
    Indirizzo = Range("Foglio1!K2").Value 'mio inserimento
    Oggetto = Range("Foglio1!K4").Value 'mio inserimento
   
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
   
    Set Sourcewb = ActiveWorkbook
   
'Copy the sheet to a new workbook
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook
   
'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
'You use Excel 2007-2010, we exit the sub when your answer is
'NO in the security dialog that you only see  when you copy
'an sheet from a xlsm file with macro's disabled.
            If Sourcewb.Name = .Name Then
                With Application
                    .ScreenUpdating = True
                    .EnableEvents = True
                End With
                MsgBox "Your answer is NO in the security dialog"
                Exit Sub
            Else
                Select Case Sourcewb.FileFormat
                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56: FileExtStr = ".xls": FileFormatNum = 56
                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select
            End If
        End If
    End With
   
'Save the new workbook/Mail it/Delete it
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Part of " & Sourcewb.Name & " " _
    & Format(Now, "dd-mmm-yy h-mm-ss")
   
    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, _
        FileFormat:=FileFormatNum
        On Error Resume Next
       
        Allegato = TempFilePath & TempFileName & FileExtStr
       
        InviaMail = "C:\Program Files (x86)\Mozilla Thunderbird\thunderbird.exe"
                     
        MiaMail = " -compose " & "to=" & Indirizzo & "," & "subject=" & Oggetto & "," & "body=" & BodyMsg & "," & "attachment=" & Allegato
       
        Shell InviaMail & MiaMail, vbNormalFocus
       
        Application.Wait (Now + TimeValue("0:00:03"))
       
        SendKeys "^+{ENTER}", True 'Cartella posta in uscita
       
        On Error GoTo 0
        .Close SaveChanges:=False
    End With
   
'Delete the file you have send
' Kill TempFilePath & TempFileName & FileExtStr
   
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub


Se preferisci l'invio automatico puoi sostituire la riga:

Codice: Seleziona tutto
SendKeys "^+{ENTER}", True

con
Codice: Seleziona tutto
SendKeys "^{ENTER}", True


Nelle impostazioni di Thunderbird devi selezionare Strumenti > Opzioni > Pagina Composizione > sezione Generale e togliere la spunta a «Chiedi conferma quando si utilizza una scorciatoia da tastiera per inviare il messaggio».


Se vuoi cancellare il file allegato dopo l'invio devi aumentare il tempo di attesa attualmente impostato a tre secondi nella riga:

Codice: Seleziona tutto
 Application.Wait (Now + TimeValue("0:00:03"))


e togliere l'apostrofo all'inizio della linea

Codice: Seleziona tutto
' Kill TempFilePath & TempFileName & FileExtStr
Avatar utente
FRIEDRICH
Utente Junior
 
Post: 31
Iscritto il: 09/07/17 17:14

Re: Macro excel per compilare campi email

Postdi BG66 » 09/10/17 11:29

Grazie è perfetto.

Se per te non ci sono problemi, posterei lo script anche sul Mozilla forum.
Attendo tuo ok.
BG66
Excel2010
Avatar utente
BG66
Utente Senior
 
Post: 261
Iscritto il: 20/08/16 07:44

Re: Macro excel per compilare campi email

Postdi FRIEDRICH » 09/10/17 13:24

Ciao,
grazie a te per il riscontro ed ovviamente nessuna obiezione a condividere il codice.
Avatar utente
FRIEDRICH
Utente Junior
 
Post: 31
Iscritto il: 09/07/17 17:14


Torna a Applicazioni Office Windows


Topic correlati a "Macro excel per compilare campi email":


Chi c’è in linea

Visitano il forum: Nessuno e 17 ospiti