You are here:--Come allegare un file generico ad una email mediante VBA ?
Come allegare un file generico ad una email mediante VBA ? 2018-03-26T17:40:09+00:00

Home Forum Domande su Excel VBA e MACRO Come allegare un file generico ad una email mediante VBA ?

  • Autore
    Articoli
  • Angelo Barachetti
    Partecipante
      Post totali: 2
      #2174 |

      Buongiorno ai moderatori e a tutti gli iscritti di questo forum

      Mi chiamo Angelo e sono appena arrivato nel forum, mastico abbastanza il VBA Excel (ora rev. 2016) ma questa volta non riesco a venirne a capo, chiedo cortesemente se qualcuno ha una soluzione e mi può aiutare con qualche dritta.

      Non ho mai partecipato ad un forum e chiedo venia in anticipo per eventuali errori nella gestione della discussione.

      Ho un file Excel “matrice” che compilo e uso abitualmente per trasmettere ordini di materiale dai cantieri all’ufficio acquisti dell’azienda dove lavoro.

      Tra le varie funzioni inserite nel VBA del file “matrice” ho una macro il cui codice crea una copia del file epurato di tutte funzioni VBA, la salva in un determinato percorso e la allega a una email che viene automaticamente generata e inviata senza aprire Outlook…e fin qui niente di trascendentale.

      Ora, a volte ho necessità di allegare alla medesima e-mail altri file presenti sul pc (file PDF, file JPEG, file WORD eccetera) ma non so come fare per inserirli in modo “semi automatico”; per esempio, durante l’esecuzione del codice vorrei (magari mediante richiesta di un MsgBox), far aprire una finestra di ricerca come quella che si utilizza in Outlook quando si allegano normalmente file alle e-mail e da lì semplicemente cliccando sul file da inserire, recuperare il percorso completo e aggiungerlo agli .Attachments.Add (percorso completo) in With OutMail al momento della creazione della e-mail.

      Per ora non allego il codice ma se serve nessun problema.

      Qualcuno sa come fare?

      Grazie in anticipo, Angelo

    • BySalvBySalv
      Amministratore del forum
        Post totali: 337

        Ciao Angelo Benvenuto nel Forum, potresti fare un elenco dei file da allegare alla tua mail, scrivendo su un foglio Excel il nome del file ed il percorso, oppure metterli tutti in una cartella e far prendere i file da questa cartella.

        Le opzioni sono molte dipende da cosa vuoi fare/ottenere, nel caso serve almeno la bozza del file tanto per vedere il formato ed al limite la tua macro per inviare le mail, in modo da poter integrare la variazione per l’invio di altri documenti.

        Ciao By Sal  :bye:

         

         

      • Angelo Barachetti
        Partecipante
          Post totali: 2

          Ciao Sal

          Grazie per la risposta

          Non posso però creare un elenco di file e delle loro directory perché non sono sempre gli stessi file, come per le normali e-mail

          In realtà se possibile vorrei che si aprisse ( dietro a una richiesta di un msgbox ) una finestra come quella che si utilizza in Outlook per ricercare manualmente e allegare un file alla e-mail, una volta selezionato il file riprendo l’esecuzione del codice.

          Allego la macro, ho evidenziato dove vorrei inserire il passaggio, in quella parte di codice per ora sono righe incomplete senza i vari controlli, solo per capire di cosa sto parlando.

          Il recupero del file é nel tag

          Un saluto, Angelo

           

           

          Private Declare PtrSafe Function InternetCheckConnection Lib “wininet.dll” Alias “InternetCheckConnectionA” _

          (ByVal lpszUrl As String, ByVal dwFlags As Long, ByVal dwReserved As Long) As Boolean

           

          Function IS_Empty(vRange As Range) As Boolean

          IS_Empty = (vRange.Count – Application.CountBlank(vRange) = 0)

          End Function

           

           

          Sub InvioMailConOrdine() ‘crea una copia del file matrice senza vba e la invia in ditta all’ufficio acquisti

          Dim fso

          Dim OutApp As Object

          Dim OutMail As Object

          Dim Btn As Integer

          Dim bConn As Boolean

           

          Dim Commessa As String

          Dim NomeCantiere As String

          Dim CopiaNomeFile As String

          Dim Folder As String

          Dim percorso As String

          Dim Percorso1 As String

          Dim percorso2 As String

          Dim Percorso3 As String

          Dim percorso4 As String

          Dim Percorso5 As String

          Dim allegato As String

          Dim testo1 As String

          Dim testo2 As String

          Dim testo3 As String

          Dim testo4 As String

          Dim strbody As String

           

          Dim rng1 As Range

          Dim rng2 As Range

          Dim rng3 As Range

          Dim rng4 As Range

          Dim wk1 As Workbook

          Dim wk2 As Workbook

          Dim sh1 As Worksheet

          Dim sh2 As Worksheet

          ‘inizio con una serie di controlli preliminari

          ‘controllo se é la matrice originale ed esco se lo é

          If [Q5] = “MATRICE  NON  MODIFICABILE” Then

          Call PlaySoundDog ‘invece del classico avviso di windows avvio un file waw di un cane che abbaia

          MsgBox ”         QUESTA  E’  LA  MATRICE  NON  MODIFICABILE !” & vbLf & ” ” & vbLf & _

          ”                La  funzione  non  é  disponibile  adesso”, vbOKOnly, “Powered By Angelo”

          Exit Sub

          End If

          ‘controllo se alcune colonne normalmente nascoste sono aperte ed esco se lo sono

          If Sheets(1).[Q5] = “A” Then

          Call PlaySoundDog ‘invece del classico avviso di windows avvio un file waw di un cane che abbaia

          MsgBox ”                                   MATRICE  APERTA !” & vbLf & ” ” & vbLf & _

          “NON  E’  POSSIBILE  CREARE  ADESSO  UNA  NUOVA  RICHIESTA !”, vbOKOnly, “Powered By Angelo”

          Exit Sub

          End If

          ‘controllo lo stato della matrice  ed esco se sto facendo modifiche

          If Sheets(1).[Q5] = “MATRICE  SBLOCCATA  E  MODIFICABILE” Then

          Call PlaySoundDog ‘invece del classico avviso di windows avvio un file waw di un cane che abbaia

          MsgBox ”           MATRICE  SBLOCCATA  E  NON  ANCORA  SALVATA !” & vbLf & ” ” & vbLf & _

          “NON  E’  POSSIBILE  CREARE  ADESSO  UNA  NUOVA  RICHIESTA !”, vbOKOnly, “Powered By Angelo”

          Exit Sub

          End If

          ‘controllo alcune celle per verificare se  é stato compilato l’ordine  ed esco se non é ancora compilato

          If IS_Empty(Range(“B7:P26″)) Then

          Call PlaySoundDog ‘invece del classico avviso di windows avvio un file waw di un cane che abbaia

          MsgBox ”     NON  HAI  ANCORA  COMPILATO  LA  RICHIESTA !” & vbLf & ” ” & vbLf & _

          ”                Non  posso  inviare  un  ordine  vuoto”, vbOKOnly, “Powered By Angelo”

          Exit Sub

          End If

          ‘controllo se é stata scritta la data di consegna del materiale ed eventualmente apro un userform per inserirla

          If Sheets(1).[M4] = “” Then

          ‘scrivo sulle label del form i riferimenti di cosa inserire

          UserForm2.Label1 = “NON  HAI  INSERITO  LA  DATA  DI  CONSEGNA  DEL  MATERIALE !”

          UserForm2.Label2 = “Inseriscila  qui  sotto  e  carica  i  dati”

          UserForm2.Label3 = “”

          ‘scrivo sulla label4 “invisibile” un riferimento per sapere cosa sto elaborando essendo unico il form di correzione per errori diversi

          UserForm2.Label4 = “DataDiConsegna”

          UserForm2.CommandButton1.Caption = “CARICA  LA  DATA  NELLA  RICHIESTA  MATERIALE”

          UserForm2.TextBox1 = “”

          UserForm2.Top = 200

          UserForm2.Left = 300

          UserForm2.Show ‘ apro il form di correzione

          DoEvents

          End If

          Btn = MsgBox(”   VUOI  INVIARE  ADESSO  IL  NUOVO  ORDINE  MATERIALE ?” & vbLf & ” ” & vbLf & _

          ”                           Premi  OK  per  inviare  l’ordine” & vbLf & ” ” & vbLf & _

          ”      Premi  ANNULLA  oppure  X  per  tornare  alla  richiesta”, vbQuestion + vbOKCancel, “Powered By Angelo”)

          Select Case Btn

          Case vbCancel

          Exit Sub

          Case vbOK

          ‘ inizio la procedura di creazione di una copia ddi questo file su una base xlsx (tolgo il vba) per l’invio

          Commessa = Range(“M3”).Value

          NomeCantiere = Range(“F3”).Value

          CopiaNomeFile = Mid(ThisWorkbook.Name, 1, Len(ThisWorkbook.Name) – 5)

          ‘blocco l’aggiornamento dello schermo

          Application.ScreenUpdating = False

          ‘verifico se esiste il percorso  dove salvare la nuova richiesta materiali

          percorso = Dir(“C:\Miaditta\Cantieri aperti\” & NomeCantiere & “\Ordini materiale\Ordini inviati”, vbDirectory)

          If percorso = “” Then

          MsgBox ” NON  TROVO  LA  CARTELLA  DI  DESTINAZIONE  DOVE  VERRA'” & vbLf & _

          ”     SALVATO  IL  FILE  DELLA  NUOVA  RICHIESTA  MATERIALE” & vbLf & ” ” & vbLf & _

          ”       Verifica  se  é  stata  spostata  o  cancellata  o  rinominata !” & vbLf & ” ” & vbLf & _

          ”               La  cartella  (Copie di ordini inviati)  deve  stare” & vbLf & _

          ”                                nel  percorso  sottoelencato” & vbLf & ” ” & vbLf & _

          percorso, vbCritical, “Powered By Angelo”

          Exit Sub

          End If

          ‘verifico se esiste il file che userò come base per compilare la richiesta da mandare in ufficio acquisti

          Percorso1 = Dir(“C:\Miaditta\FileDatiPerOrdiniMateriale\Richiesta materiale (MATRICE ORDINE).xlsx”)

          If Percorso1 = “” Then

          MsgBox ”     NON  TROVO  IL  FILE  MATRICE  CHE  VERRA’  UTILIZZATO” & vbLf & _

          ”          PER  COMPILARE  L’ORDINE  DA  INVIARE  IN  DITTA” & vbLf & ” ” & vbLf & _

          ”       Verifica  se  é  stato  spostato  o  cancellato  o  rinominato !” & vbLf & ” ” & vbLf & _

          ”         Il  file  (Richiesta materiali(MATRICE ORDINE))” & vbLf & _

          ”                      deve  stare  nel  percorso  sottoelencato” & vbLf & ” ” & vbLf & _

          Percorso1, vbCritical, “Powered By Angelo”

          Exit Sub

          End If

          ‘ apro il file matrice per creare il file senza vba che verrà compilato prima di essere spedito

          percorso2 = “C:\STBG.exe\FileDatiPerOrdiniMateriale\Richiesta materiale (MATRICE ORDINE).xlsx”

          Workbooks.Open FileName:=percorso2

          ‘tolgo la protezione al foglio 1

          ActiveWorkbook.Sheets(1).Unprotect “1973”

          ‘ sblocco le celle che verranno compilate per la nuova richiesta materiale

          ActiveWorkbook.Sheets(1).[A5:P25,A30:P50,A55:P75].Locked = False

          ‘ salvo con nome una copia per mantenere intatta la matrice ma prima verifico se esiste già un file con lo stesso nome

          Percorso5 = “C:\STBG.exe\Cantieri aperti.exe\” & NomeCantiere & “\Ordini materiale\Ordini inviati\” & CopiaNomeFile & “.xlsx”

          ‘ se esisteva già il file

          If Dir(“C:\STBG.exe\Cantieri aperti.exe\” & NomeCantiere & “\Ordini materiale\Ordini inviati\” & CopiaNomeFile & “.xlsx”) <> “” Then

          ‘ prima elimino il file che esisteva

          Kill (Percorso5)

          ‘ poi salvo una nuova copia del file pronto per essere compilato chiudendo la matrice ordine

          ActiveWorkbook.SaveAs FileName:=”C:\STBG.exe\Cantieri aperti.exe\” & NomeCantiere & “\Ordini materiale\Ordini inviati\” & CopiaNomeFile & “.xlsx”

          Else

          ‘ se non esisteva salvo una copia del file pronto per essere compilato chiudendo la matrice ordine

          ActiveWorkbook.SaveAs FileName:=”C:\STBG.exe\Cantieri aperti.exe\” & NomeCantiere & “\Ordini materiale\Ordini inviati\” & CopiaNomeFile & “.xlsx”

          End If

          ‘ memorizzo il nome del file per successivo utilizzo

          Percorso3 = ActiveWorkbook.Name

          ‘ memorizzo il nome completo (percorso e nome) del file per successivo utilizzo

          percorso4 = ActiveWorkbook.FullName ‘Percorso completo del file

          ‘tolgo alcune scritte dal foglio

          ActiveSheet.Shapes.Range(Array(“Rectangle 4”)).Delete

          ActiveSheet.Shapes.Range(Array(“Rectangle 5”)).Delete

          ActiveSheet.Shapes.Range(Array(“Rectangle 6″)).Delete

          ‘gestione errori

          On Error GoTo RigErr

          ‘metto i riferimenti ai files

          Set wk1 = ThisWorkbook

          Set wk2 = Workbooks(Percorso3) ‘(” & CopiaNomeFile & “Ordine” & “.xlsx”)’C:\STBG.exe\Cantieri aperti.exe\” & NomeCantiere & “\Ordini materiale\Copie di ordini inviati\” & CopiaNomeFile & “Ordine” & “.xlsx”)

          ‘metto i riferimenti ai fogli

          Set sh1 = wk1.Worksheets(“Foglio1”)

          Set sh2 = wk2.Worksheets(“Ordine”)

          With sh1

          ‘copio i dati da un file all’altro compilando le celle relative al cantiere

          .Range(“F3:I3”).Copy Destination:=sh2.Range(“F2:I2”)

          .Range(“F4:I4”).Copy Destination:=sh2.Range(“F3:I3”)

          .Range(“F5:I5”).Copy Destination:=sh2.Range(“F4:I4”)

          .Range(“M3:P3”).Copy Destination:=sh2.Range(“M2:P2”)

          .Range(“M4:P4”).Copy Destination:=sh2.Range(“M3:P3”)

          .Range(“M5:P5”).Copy Destination:=sh2.Range(“M4:P4”)

          ‘copio i dati da un file all’altro compilando le celle relative al materiale ordinato

          .Range(“B7:P26”).Copy Destination:=sh2.Range(“B6”)

          .Range(“B32:P51”).Copy Destination:=sh2.Range(“B31”)

          .Range(“B57:P76”).Copy Destination:=sh2.Range(“B56”)

          End With

          ‘imposto l’area di stampa

          Fg1 = 1

          If IS_Empty(sh2.Range(“B56:P75”)) Then

          Fg3 = 0

          Else

          Fg3 = 1

          End If

          If IS_Empty(sh2.Range(“B31:P50”)) Then

          Fg2 = 0

          Else

          Fg2 = 1

          End If

          FgT = Fg1 + Fg2 + Fg3

          If FgT = 1 Then

          Set AreaDiStampa = sh2.Range(“$A$1:$P$25”)

          sh2.Range(“N1”) = “Foglio 1 di 1”

          ‘sh2.Range(“N26”) = “”

          ‘sh2.Range(“N51”) = “”

          sh2.Range(“A26:P75”).Delete Shift:=xlUp

          sh2.Shapes.Range(Array(“Picture 8”)).Delete

          sh2.Shapes.Range(Array(“Picture 9”)).Delete

          End If

          If FgT = 2 Then

          Set AreaDiStampa = sh2.Range(“$A$1:$P$50”)

          sh2.Range(“N1”) = “Foglio 1 di 2”

          sh2.Range(“N26”) = “Foglio 2 di 2”

          ‘sh2.Range(“N51”) = “”

          sh2.Range(“A51:P75”).Delete Shift:=xlUp

          sh2.Shapes.Range(Array(“Picture 9”)).Delete

          End If

          If FgT = 3 Then

          Set AreaDiStampa = sh2.Range(“$A$1:$P$75”)

          sh2.Range(“N1”) = “Foglio 1 di 3”

          sh2.Range(“N26”) = “Foglio 2 di 3”

          sh2.Range(“N51”) = “Foglio 3 di 3”

          End If

          ‘blocco la cella “data di consegna”

          wk2.Sheets(1).Range(“M3:P3”).Locked = True

          ‘riporto in posizione la selezione

          wk2.Sheets(1).Range(“B6”).Select

          Application.GoTo reference:=ActiveCell, Scroll:=True

          With ActiveWindow

          .SmallScroll Up:=5, ToLeft:=1

          End With

          ‘metto la protezione sul foglio (rimossa funzione)

          ‘wk2.Sheets(1).Protect “1973”, DrawingObjects:=True, Contents:=True, Scenarios:=True

          ‘chiudo il foglio pronto per l’invio

          wk2.Close SaveChanges:=True

          ‘———————————————————————————————————————————–

          ‘qui chiedo se ci sono altri file da allegare

          ‘MsgBox “Hai altri file da allegare alla e-mail?”

           

          ‘If vbOK Then

          ‘in questo punto creerò una prima istruzione per allegare altri documenti

          ‘file1 = Dir(“C:\MioPc\Miofile\Allegato1.xlsx”) ‘questa directory deve compilarsi automaticamente dopo aver scelto il file da allegare

          ‘in questo punto creerò una seconda istruzione per allegare altri documenti

          ‘file2 = Dir(“C:\MioPc\Miofile\Allegato2.xlsx”) ‘questa directory deve compilarsi automaticamente dopo aver scelto il file da allegare

          ‘in questo punto creerò una terza istruzione per allegare altri documenti

          ‘file3 = Dir(“C:\MioPc\Miofile\Allegato3.xlsx”) ‘questa directory deve compilarsi automaticamente dopo aver scelto il file da allegare

          ‘End If

           

          ‘———————————————————————————————————————————–

          ‘riga sempre eseguita

          RigaChiusura:

          ‘Set a Nothing delle variabili oggetto

          Set sh2 = Nothing

          Set sh1 = Nothing

          Set wk1 = Nothing

          Set wk2 = Nothing

          FgT = 1

          Application.DisplayAlerts = False

          Set OutApp = CreateObject(“Outlook.Application”)

          Set OutMail = OutApp.CreateItem(0)

          strbody = “Ciao Sig.Rossi” & vbNewLine & vbNewLine & _

          “In allegato un ordine per il cantiere ” & NomeCantiere & ” ” & vbNewLine & vbNewLine & _

          “Grazie”

          ‘”This is line 3″ & vbNewLine & _

          ‘”This is line 4″

          On Error Resume Next

          With OutMail

          .To = “sig.rossi@miaditta.it”

          .CC = “”

          .BCC = “”

          .Subject = “Ordine materiale comm. ” & Commessa

          .Body = strbody ‘”Ciao”

          .Attachments.Add (percorso4)

          ‘———————————————————————————————————

          ‘.Attachments.Add (file1)’se ho altri documenti li voglio mettere qui

          ‘.Attachments.Add (file2)’se ho altri documenti li voglio mettere qui

          ‘.Attachments.Add (file3)’se ho altri documenti li voglio mettere qui

          ‘———————————————————————————————————

          .Send

          End With

          DoEvents

          ‘OutMail = OutApp.CreateItem(0).Send

           

          Set OutMail = Nothing

          Set OutApp = Nothing

          Application.DisplayAlerts = True

          ‘verifico se é presente una connessione internet

          Const sUrl As String = “google.it”

          bConn = InternetCheckConnection(“h t t p://” & sUrl, &H1, &H0) ‘tolgo gli spazi in “h t t p”

          If bConn Then

          ‘chiudo con un messaggio di conferma dell’avvenuto invio dell’ordine

          MsgBox ”     RICHIESTA  MATERIALI  INVIATA  CORRETTAMENTE” & vbLf & ” ” & vbLf & _

          ”                     Arrivederci  al  prossimo  ordine !!”, vbInformation + vbOKOnly, “Powered By Angelo”

          ActiveWorkbook.Save ‘ Close SaveChanges:=True

          Application.Quit

          Exit Sub

          Else

          MsgBox ”      LA  CONNESSIONE  INTERNET  AL  MOMENTO  E’ ASSENTE !!” & vbLf & ” ” & vbLf & _

          ”     La  mail  di  richiesta  materiale  verrà  parcheggiata  in  Outlook ,” & vbLf & _

          ”      al  ripristino  della  connessione  sarà  inviata  automaticamente”, vbCritical, “Powered By Angelo”

          ActiveWorkbook.Save ‘Close SaveChanges:=True

          Application.Quit

          Exit Sub

          End If

          End Select

           

          RigErr:

          MsgBox Err.Number & vbNewLine & Err.Description

          wk2.Close SaveChanges:=False

          Kill (percorso4)

          Set sh2 = Nothing

          Set sh1 = Nothing

          Set wk1 = Nothing

          Set wk2 = Nothing

          MsgBox ”    ATTENZIONE  !!!      SI  E’  VERIFICATO  UN  ERRORE  IMPREVISTO” & vbLf & _

          ”       DURANTE  CREAZIONE  DEL  FILE  DA  ALLEGARE  ALLA  MAIL” & vbLf & ” ” & vbLf & _

          “Riperete  la  procedura  di  invio  ordine  facendo  un  ultimo  tentativo,” & vbLf & _

          ”  se  il  problema  si  ripresenta,  inviare  l’ordine  in  modo  manuale” & vbLf & ” ” & vbLf & _

          Err.Number & vbNewLine & Err.Description, vbCritical, “Powered By Angelo”

          Exit Sub

          End Sub

           

           

           

           

        Devi essere loggato per rispondere a questa discussione.

        Utilizzando il sito, accetti l'utilizzo dei cookie da parte nostra. maggiori informazioni

        Questo sito utilizza i cookie per fornire la migliore esperienza di navigazione possibile. Continuando a utilizzare questo sito senza modificare le impostazioni dei cookie o cliccando su "Accetta" permetti il loro utilizzo.

        Chiudi