Sviluppare funzionalita su Microsoft Office con VBA Inserire parte del contenuto dell’allegato nel corpo della mail es. Ron De Bruin

LoginRegistrati
Stai vedendo 25 articoli - dal 1 a 25 (di 25 totali)
  • Autore
    Articoli
  • #25979 Risposta

    PDA
    Partecipante

      Ciao a tutti,
      chiedo il Vs aiuto per questa mia nuova esigenza.

      Come dice il titolo, vorrei che una parte del contenuto dell’allegato alla mail (dalla colonna C alla colonna J, e dalla riga 2 alla fine – che può essere variabile) venga inserita nel corpo della mail.

      In un altro progetto ho utilizzato il codice di Ron De Bruin, che riporto sotto, ma non so come adattarlo a questo nuovo progetto, che prevede la generazione di molti allegati e quindi l’invio di altrettante mail.

      Function RangetoHTML(rng As Range)
      ' Changed by Ron de Bruin 28-Oct-2006
      ' Working in Office 2000-2016
          Dim fso As Object
          Dim ts As Object
          Dim TempFile As String
          Dim TempWB As Workbook
      
          TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
      
          'Copy the range and create a new workbook to past the data in
          rng.Copy
          Set TempWB = Workbooks.Add(1)
          With TempWB.Sheets(1)
              .Cells(1).PasteSpecial Paste:=8
              .Cells(1).PasteSpecial xlPasteValues, , False, False
              .Cells(1).PasteSpecial xlPasteFormats, , False, False
              .Cells(1).Select
              Application.CutCopyMode = False
              On Error Resume Next
              .DrawingObjects.Visible = True
              .DrawingObjects.Delete
              On Error GoTo 0
          End With
      
          'Publish the sheet to a htm file
          With TempWB.PublishObjects.Add( _
               SourceType:=xlSourceRange, _
               Filename:=TempFile, _
               Sheet:=TempWB.Sheets(1).Name, _
               Source:=TempWB.Sheets(1).UsedRange.Address, _
               HtmlType:=xlHtmlStatic)
              .Publish (True)
          End With
      
          'Read all data from the htm file into RangetoHTML
          Set fso = CreateObject("Scripting.FileSystemObject")
          Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
          RangetoHTML = ts.readall
          ts.Close
          RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                                "align=left x:publishsource=")
      
          'Close TempWB
          TempWB.Close SaveChanges:=False
      
          'Delete the htm file we used in this function
          Kill TempFile
      
          Set ts = Nothing
          Set fso = Nothing
          Set TempWB = Nothing
          
      End Function

      Spero che qualcuno mi possa dare qualche suggerimento.

      Grazie in anticipo.

      Saluti,
      PDA

      Allegati:
      You must be logged in to view attached files.
      #26044 Risposta

      PDA
      Partecipante

        Buongiorno Signori,

        questo silenzio mi preoccupa...

        Non sono riuscito ad attirare la Vs attenzione?

        Attendo fiducioso.

        Grazie mille.

        Saluti,

        PDA 

        #26049 Risposta
        tanimon
        tanimon
        Partecipante
          6 pts

          ciao,

          Beh, hai fatto la richiesta a mezzanotte in punto del 19/05 ed oggi è solo il 20/05,

          capisco le necessità, meno la fretta.................

           

          avevo fatto qualcosa del genere in passato, ma non so dirti quando troverò tempo per passarti un file

          che tra l'altro dovresti testare tu:  io non uso Outlook.

          Intanto puoi provare a fare due cicli For Next uno dentro l'altro, per riga e colonna concatenando e spaziando il valore di ogni cella, andando a capo con VbCrlf completata ogni riga, in una stringa che sarà il Body della mail.

          Guardando il sito di Ron De Bruin, il resto è semplice.

           

          Buon lavoro

          Frank

           

          #26054 Risposta
          tanimon
          tanimon
          Partecipante
            6 pts

            ciao Paolo,

            scusa se mi sono permesso, ma ho visto che ti sei loggato intorno all 13:26 odierne.

            Solo per dirti che come Tu avresti desiderato ricevere riscontro alla Tua richiesta,

            a me, avrebbe fatto piacere ricevere riscontro da parte Tua alla mia risposta, ancorchè non risolutiva.

            Grazie per l'attenzione.

            un saluto.

            Frank

             

             

            #26056 Risposta

            PDA
            Partecipante

              Ciao Frank,

              scusami ma non era mia intenzione non riscontrare il tuo suggerimento.

              Anzi, devo solo ringraziarti per l'interesse dimostrato.

              La mia insistenza al post n. 2 è dovuta al fatto che questo è il secondo forum dove espongo il mio problema (nel primo ho chiesto l'autorizzazione a poterlo fare) e da quel momento ho capito che forse la mia esigenza è un pò difficile da risolvere.

              Stavo risolvendo un problema lavorativo e poi mi sarei dedicato all'implementazione del tuo suggerimento (non ti nascondo che tra l'altro non l'ho neanche capito!).

              Come hai notato dall'ora di apertura della discussione, i miei orari sono leggermente dilatati.

              Ti tengo aggiornato entro domani tardo pomeriggio.

              Grazie mille e scusami ancora.

              Saluti,

              PDA

              #26062 Risposta

              PDA
              Partecipante

                Ciao Frank,

                credo di non riuscire a venirne a capo.

                Il problema è che ogni mail ha un allegato con nome differente dall'altro.

                Per ottenere il giusto Range è come se si dovesse aprire l'allegato, copiare il range, e richiuderlo.

                Di seguito riporto il codice che mi consente di allegare il file corretto alla mail:

                `For Each MioFile In Miacartella.Files
                            If MioFile.Name Like "*" & StringaDaCercare & "*" Then
                                 .Attachments.Add (MioFile.Path)
                            End If
                        Next</code></pre><p>Che è un di cui di questo:</p><pre class="language-c"><code>Option Explicit
                
                Sub InviaMailPro7gg() 'Invia mail ai clienti presenti nel foglio "ProMemoria 7 gg"
                
                  Dim fso As Object
                  Dim sFolder As String
                  Dim MioFile As Variant
                  Dim Miacartella As Object
                  Dim PubFile As Object
                  Dim StringaDaCercare As String
                  Dim sTO, sCC, sBody, sObj, sFrom, XX, x, NomeFile As String
                  Dim otlApp As Object
                  Dim otlNewMail As Object
                  Dim i, z, ur As Long
                  Dim risp As VbMsgBoxResult
                  Dim wk1 As Workbook
                  Dim sh As Worksheet
                  Dim rng As Range
                 
                  Const accapo As String = "
                "
                 
                  Set sh = ThisWorkbook.Worksheets("ProMemoria 7 gg")
                 
                risp = MsgBox("INVIARE  I  FILE  PER  MAIL ???" _
                               , vbYesNo + vbQuestion, "ATTENZIONE ???")
                              
                  If risp = vbYes Then 'se rispondo SI alla domanda "INVIARE  I  FILE  PER  MAIL ???"
                 
                  sFolder = (Environ("USERPROFILE") & "\Desktop\Gestione SCADUTI\" & "Comunicazioni ProMemoria 7 gg") 'You can specify your Folder which you wants to Open
                  Set fso = CreateObject("Scripting.FileSystemObject")
                  Set Miacartella = fso.getfolder(sFolder)
                 
                  With sh
                    z = .Range("A" & .Rows.Count).End(xlUp).Row
                    
                    'CICLO CELLE E MANDO AD OGNI INDIRIZZO UNA MAIL
                    For i = 5 To z
                                    
                 If .Cells(i, 11) <> "" Then
                                    
                    ''''''''''''INDIVIDUO ELEMENTI DELLA MAIL''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                      sTO = .Cells(i, 11) 'Destinatario
                      sCC = .Cells(i, 13) 'Copia Conoscenza
                      sObj = "Promemoria Prossima Scadenza al " & .Cells(i, 4) '& " " & .Cells(i, 3) & " (cod. " & .Cells(i, 2) & ")" & " al " & .Cells(2, 9) 'Oggetto
                     ' sBody = .Cells(i, 7) & Chr(13) & .Cells(i, 8) & Chr(13) & .Cells(i, 9) & Chr(13) _
                              & Chr(13) & .Cells(i, 10) & Chr(13) & Chr(13) & .Cells(i, 11) & Chr(13) & Chr(13) _
                              & .Cells(i, 12) & Chr(13) & .Cells(i, 13)    'Testo
                      'sFrom = .Cells(i, 2) 'Mittente in caso si voglia modificare tra quelli disponibili in outlook
                      
                       StringaDaCercare = .Cells(i, 2)    
                XIT:
                       Application.ScreenUpdating = True
                    ''''''''''''''CREO LA MAIL E UTILIZZO LE INFORMAZIONI RACCOLTE SOPRA''''''''''''''''''''''''''''''''''''''''
                      Set otlApp = CreateObject("Outlook.Application")
                      Set otlNewMail = otlApp.CreateItemFromTemplate("C:\Users\Ry03360\Desktop\Listini NAPOLI\Firma Ufficio Napoli Platts.oft")
                 
                     With otlNewMail
                        .SentOnBehalfOfName = """SenderName"" <ordini@repsol.com>"
                        .To = sTO 'Destinatario
                        .CC = sCC 'Copia Conoscenza
                        .BCC = "" 'Copia Nascosta
                        .Subject = sObj 'Oggetto
                
                        For Each MioFile In Miacartella.Files
                            If MioFile.Name Like "*" & StringaDaCercare & "*" Then
                                 .Attachments.Add (MioFile.Path)
                            End If
                        Next
                        
                        'RangetoHTML(rng) & _
                        'If Trim(ws.Cells(i, 25)) > 0 And Trim(ws.Cells(i, 25)) <> "" Then
                        .HTMLBody = RangetoHTML(rng)
                        ''.HTMLBody = "" & "" & "" & "Spett.le" & "" & "" & " " & _
                                    "" & Trim(sh.Cells(i, 2)) & "" & "," & accapo & _
                                    "Vi invitiamo a prendere visione della comunicazione in allegato." & _
                                    accapo & accapo & "Restiamo a disposizione e porgiamo i nostri più cordiali saluti." & _
                                    accapo & 'accapo & .HTMLBody 'dalla colonna L - 12 si parla della composizione del file"
                        
                        '.Body = sBody 'Testo della mail
                     .Display
                     '.Send
                          End With   
                Else
                 ' i = i + 1
                End If
                 Next i
                 
                    End With
                      
                sh.Range("A1").Select
                ActiveWorkbook.Save
                                  
                      Else 'se rispondo NO alla domanda "INVIARE  I  FILE  PER  MAIL ???"
                      Exit Sub
                      End If
                                
                    With Application
                        .EnableEvents = True
                        .ScreenUpdating = True
                    End With
                 
                  If Not otlApp Is Nothing Then Set otlApp = Nothing
                  If Not otlNewMail Is Nothing Then Set otlNewMail = Nothing
                  Set sh = Nothing
                  Set fso = Nothing
                 
                End Sub
                
                Function RangetoHTML(rng As Range)
                ' Changed by Ron de Bruin 28-Oct-2006
                ' Working in Office 2000-2016
                    Dim fso As Object
                    Dim ts As Object
                    Dim TempFile As String
                    Dim TempWB As Workbook
                
                    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
                
                    'Copy the range and create a new workbook to past the data in
                    rng.Copy
                    Set TempWB = Workbooks.Add(1)
                    With TempWB.Sheets(1)
                        .Cells(1).PasteSpecial Paste:=8
                        .Cells(1).PasteSpecial xlPasteValues, , False, False
                        .Cells(1).PasteSpecial xlPasteFormats, , False, False
                        .Cells(1).Select
                        Application.CutCopyMode = False
                        On Error Resume Next
                        .DrawingObjects.Visible = True
                        .DrawingObjects.Delete
                        On Error GoTo 0
                    End With
                
                    'Publish the sheet to a htm file
                    With TempWB.PublishObjects.Add( _
                         SourceType:=xlSourceRange, _
                         Filename:=TempFile, _
                         Sheet:=TempWB.Sheets(1).Name, _
                         Source:=TempWB.Sheets(1).UsedRange.Address, _
                         HtmlType:=xlHtmlStatic)
                        .Publish (True)
                    End With
                
                    'Read all data from the htm file into RangetoHTML
                    Set fso = CreateObject("Scripting.FileSystemObject")
                    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
                    RangetoHTML = ts.ReadAll
                    ts.Close
                    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                                          "align=left x:publishsource=")
                
                    'Close TempWB
                    TempWB.Close SaveChanges:=False
                
                    'Delete the htm file we used in this function
                    Kill TempFile
                
                    Set ts = Nothing
                    Set fso = Nothing
                    Set TempWB = Nothing
                    
                End Function`

                Il codice principale consente di allegare alla mail il file che contiene nel nome il codice agente (I2x) corrispondente a quel determinato indirizzo mail, grazie alle istruzioni riportate in alto.

                Spero abbia fornito le giuste informazioni per consentirti di potermi aiutare.

                Grazie mille.

                Saluti,

                PDA

                #26063 Risposta
                tanimon
                tanimon
                Partecipante
                  6 pts

                  ciao Paolo,

                  PDA ha scritto:

                  Come dice il titolo, vorrei che una parte del contenuto dell’allegato alla mail (dalla colonna C alla colonna J, e dalla riga 2 alla fine – che può essere variabile) venga inserita nel corpo della mail.

                  mi limito a passarti un codice che crea una stringa come hai richiesto.

                  inseriscilo nel punto della tua macro in cui è richiesto per far sì che il Body della mail sia

                  .Body = stringa e fai una prova.

                  A suo tempo ho preso anch'io spunto dal sito di Ron De Bruin  adattando un suo codice alle mie necessità, ora ho adattato il mio alle tue.

                  Fai sapere 

                  Frank

                  Dim stringa As String
                  Dim r As Long, c As Long, ur As Long
                  
                  ur = Cells(Rows.Count, "c").End(xlUp).Row
                  
                  
                  For r = 2 To ur
                      For c = 3 To 10
                          stringa = stringa & Cells(r, c).Value & "    "
                      Next c
                  stringa = stringa & vbNewLine
                  Next r
                  
                  MsgBox stringa
                  

                   

                   

                  #26070 Risposta

                  PDA
                  Partecipante

                    Ciao Frank,

                    ti ringrazio per l'aiuto.

                    Ad un primo veloce test, sembra che possa fare al caso mio.

                    Ti chiedo di concedermi qualche giorno per poter effettuare delle prove più approfondite (solitamente riesco nel fine settimana) e ti aggiorno.

                    Grazie mille per tutto.

                    Saluti,

                    PDA

                    #26081 Risposta

                    PDA
                    Partecipante

                      Ciao Frank,

                      sono riuscito a fare qualche prova.

                      Ma la mia difficoltà resta sempre quella di individuare il file già allegato alla mail (che è sempre diverso per ogni mail), e di quello copiare il contenuto nel corpo della mail.

                      Saluti,

                      PDA 

                      #26082 Risposta
                      tanimon
                      tanimon
                      Partecipante
                        6 pts

                        ciao Paolo,

                        PDA ha scritto:

                        Ma la mia difficoltà resta sempre quella di individuare il file già allegato alla mail

                        questo è una problematica diversa dal titolo della discussione.

                        Mi verrebbe di dirti di aprire una discussione ad hoc, ma non creamone un'altra......

                        Prima dell'istruzione con cui alleghi il file, setta il Workbook interessato e fagli elaborare la stringa che ti intesssa,

                        poi lo chiudi, lo alleghi, ed il resto lo sai già

                        ciao

                        Frank

                         

                        #26092 Risposta

                        PDA
                        Partecipante

                          Ciao Frank,

                          il problema per me è proprio questo. Non so ho capito come individuo il Workbook interessato.

                          L'istruzione con cui allego il file specifico per quella mail e quindi per quel determinato cliente è questa:

                          For Each MioFile In Miacartella.Files
                                      If MioFile.Name Like "*" & StringaDaCercare & "*" Then
                                           .Attachments.Add (MioFile.Path)
                                      End If
                                  Next

                           Ma non ho capito come individuarlo.

                          Saluti,

                          PDA

                          #26093 Risposta
                          tanimon
                          tanimon
                          Partecipante
                            6 pts

                            ciao Paolo,

                            vediamo se riusciamo a capirci.....

                            io non so quale file vuoi allegare

                            il tuo computer nemmeno

                            l'unico che lo sà sei tu! e Tu devi dire al computer quale file file allegare

                            e glielo dici con le istruzioni che hai indicato.

                            se vuoi sapere quale file sarà l'allegato, prova così

                            For Each MioFile In Miacartella.Files
                                        If MioFile.Name Like "*" & StringaDaCercare & "*" Then
                            msgbox MioFile
                                            
                                        End If
                                    Next

                             

                            #26098 Risposta

                            PDA
                            Partecipante

                              Ciao Frank,

                              cerco di spiegare il progetto completo:

                              -          Creo file specifici che contengono tutti i dati relativi ai clienti appartenenti ad un determinato codice agente, identificato dalla sigla I2x (la x cambia a seconda dell’agente);

                              -          Questi file vengono salvati in una cartella temporanea (che poi sarà eliminata);

                              -          Il codice postato nei post precedenti consente di identificare il file in base alla sigla del codice contenuto nel nome, confrontando tale sigla con l’elenco delle sigle presente in un foglio principale dove è presente il bottone che attiva l’intero progetto;

                              -          Quindi dovrei aprire il file dopo averlo allegato, copiare il range che mi interessa, chiudere il file ed inviare la mail.

                              Qui mi incarto.

                              #26099 Risposta
                              tanimon
                              tanimon
                              Partecipante
                                6 pts

                                ciao Paolo,

                                andiamo per gradi:

                                per quanto mi riguarda questa discussione è risolta: chiudila con l'apposito flag.

                                per quanto segnali nel tuo ultimo post,

                                PDA ha scritto:

                                Quindi dovrei aprire il file dopo averlo allegato, copiare il range che mi interessa, chiudere il file ed inviare la mail.

                                io farei il contrario, prima lo apro, valorizzo la variabile con il range che mi interessa, lo chiudo e lo allego.

                                Nella tua macro metti i passaggi  nella sequenza necessaria.

                                 

                                creati un file di test nuovo con pochi dati e fai le tue prove, poi implementi il file da utilizzare.

                                Nel caso, per questa nuova problematica, apri una nuova discussione con allegato il file di test.

                                Ciao

                                Frank

                                #26100 Risposta

                                PDA
                                Partecipante

                                  Scusami Frank,

                                  perché ritieni che il titolo della discussione non vada bene?

                                  Credo che rispecchi quello di cui ho bisogno.

                                  Ho un file allegato alla mail. Di questo file devo copiarne una parte del contenuto ed incollarlo nel corpo della stessa mail.

                                  #26101 Risposta
                                  tanimon
                                  tanimon
                                  Partecipante
                                    6 pts

                                    non lo ritengo adatto, perchè ora parli di individuare il file,

                                    di cui copiare un range in una variabile.

                                    il titolo della discussione si riferisce alla sola parte di determinazione del range di un file che avevo capito fosse già conosciuto.

                                    Almeno così l'avevo capita io.

                                     In ogni caso,

                                    io farei il contrario, prima lo apro, valorizzo la variabile con il range che mi interessa, lo chiudo e lo allego.

                                    Nella tua macro metti i passaggi  nella sequenza necessaria.
                                     

                                    Frank

                                    #26103 Risposta

                                    PDA
                                    Partecipante

                                      Sicuramente allora ho espresso male il concetto.

                                      Il file è correttamente individuato da questo parte del codice:

                                      For Each MioFile In Miacartella.Files
                                                  If MioFile.Name Like "*" & StringaDaCercare & "*" Then
                                                    'MsgBox MioFile
                                                    MioFile.Open
                                                       .Attachments.Add (MioFile.Path)
                                                  End If
                                              Next

                                      Il punto è riportare una parte del contenuto di questo allegato nel corpo della mail a cui è appunto allegato.

                                      #26105 Risposta
                                      tanimon
                                      tanimon
                                      Partecipante
                                        6 pts

                                        caro Paolo,

                                        ti consiglio di rileggeti TUTTO il Tread:

                                        PDA ha scritto:

                                        Ciao Frank,

                                        il problema per me è proprio questo. Non so ho capito come individuo il Workbook interessato.

                                        L'istruzione con cui allego il file specifico per quella mail e quindi per quel determinato cliente è questa:

                                        For Each MioFile In Miacartella.Files            If MioFile.Name Like "*" & StringaDaCercare & "*" Then                 .Attachments.Add (MioFile.Path)            End If        Next

                                         Ma non ho capito come individuarlo.

                                        questo non l'ho scritto io.

                                         

                                        e comunque credo di averti dato il 100% della soluzione che hai chiesto.

                                        Hai provato a fare quanto ti ho consigliato?

                                        tanimon ha scritto:

                                        io farei il contrario, prima lo apro, valorizzo la variabile con il range che mi interessa, lo chiudo e lo allego.

                                        Nella tua macro metti i passaggi  nella sequenza necessaria.

                                         

                                        Quando avrai fatto le prove che ti ho indicato,

                                        specifica dettagliatamente quale variabile e/o porzione del progetto ti crea dei problemi.

                                        Per quanto credo opportuno, meglio se in una nuova discussione.

                                         

                                        Ciao

                                        Frank

                                        #26179 Risposta

                                        PDA
                                        Partecipante

                                          Ciao Frank,

                                          credo di esserci riuscito, grazie ai tuoi preziosissimi consigli.

                                          Ma prima di postare il codice definitivo, ho un'ultima richiesta da farti, se posso.

                                          Vorrei che la parte del contenuto dell'allegato che sarà copiato nel corpo della mail sia fatto sotto forma di immagine.

                                          Al codice di Ron De Bruin, di cui sotto:

                                          Function RangetoHTML(rng As Range)
                                          ' Changed by Ron de Bruin 28-Oct-2006
                                          ' Working in Office 2000-2016
                                              Dim fso As Object
                                              Dim ts As Object
                                              Dim TempFile As String
                                              Dim TempWB As Workbook
                                          
                                              TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
                                          
                                              'Copy the range and create a new workbook to past the data in
                                              rng.Copy
                                              Set TempWB = Workbooks.Add(1)
                                              With TempWB.Sheets(1)
                                                  .Cells(1).PasteSpecial Paste:=8
                                                  .Cells(1).PasteSpecial xlPasteValues, , False, False
                                                  .Cells(1).PasteSpecial xlPasteFormats, , False, False
                                                  .Cells(1).Select
                                                  Application.CutCopyMode = False
                                                  On Error Resume Next
                                                  .DrawingObjects.Visible = True
                                                  .DrawingObjects.Delete
                                                  On Error GoTo 0
                                              End With
                                          
                                              'Publish the sheet to a htm file
                                              With TempWB.PublishObjects.Add( _
                                                   SourceType:=xlSourceRange, _
                                                   Filename:=TempFile, _
                                                   Sheet:=TempWB.Sheets(1).Name, _
                                                   Source:=TempWB.Sheets(1).UsedRange.Address, _
                                                   HtmlType:=xlHtmlStatic)
                                                  .Publish (True)
                                              End With
                                          
                                              'Read all data from the htm file into RangetoHTML
                                              Set fso = CreateObject("Scripting.FileSystemObject")
                                              Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
                                              RangetoHTML = ts.readall
                                              ts.Close
                                              RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                                                                    "align=left x:publishsource=")
                                          
                                              'Close TempWB
                                              TempWB.Close SaveChanges:=False
                                          
                                              'Delete the htm file we used in this function
                                              Kill TempFile
                                          
                                              Set ts = Nothing
                                              Set fso = Nothing
                                              Set TempWB = Nothing
                                              
                                          End Function

                                          sto cercando di aggiungere queste istruzioni:

                                           rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture 'Copy
                                              
                                             
                                                   .Pictures.Paste.Select
                                                   .Shapes.Range(Array("Picture 1")).Select

                                           trasformandolo in questo modo:

                                          Function RangetoHTML(rng As Range)
                                          ' Changed by Ron de Bruin 28-Oct-2006
                                          ' Working in Office 2000-2016
                                              Dim fso As Object
                                              Dim ts As Object
                                              Dim TempFile As String
                                              Dim TempWB As Workbook
                                          
                                              TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
                                          
                                              'Copy the range and create a new workbook to past the data in
                                              rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture 'Copy
                                              
                                              Set TempWB = Workbooks.Add(1)
                                              With TempWB.Sheets(1)
                                                   .Pictures.Paste.Select
                                                   .Shapes.Range(Array("Picture 1")).Select
                                          '        .Cells(1).PasteSpecial Paste:=8
                                          '        .Cells(1).PasteSpecial xlPasteValues, , False, False
                                          '        .Cells(1).PasteSpecial xlPasteFormats, , False, False
                                                  .Cells(1).Select
                                                  Application.CutCopyMode = False
                                          ' .Shapes.Range(Array("Picture 1")).Select
                                                  On Error Resume Next
                                                  .DrawingObjects.Visible = True
                                                  .DrawingObjects.Delete
                                                  On Error GoTo 0
                                              End With
                                          
                                              'Publish the sheet to a htm file
                                              With TempWB.PublishObjects.Add( _
                                                   SourceType:=xlSourceRange, _
                                                   Filename:=TempFile, _
                                                   Sheet:=TempWB.Sheets(1).Name, _
                                                   Source:=TempWB.Sheets(1).UsedRange.Address, _
                                                   HtmlType:=xlHtmlStatic)
                                                  .Publish (True)
                                              End With
                                          
                                              'Read all data from the htm file into RangetoHTML
                                              Set fso = CreateObject("Scripting.FileSystemObject")
                                              Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
                                              RangetoHTML = ts.ReadAll
                                              ts.Close
                                              RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                                                                    "align=left x:publishsource=")
                                          
                                              'Close TempWB
                                              TempWB.Close SaveChanges:=False
                                          
                                              'Delete the htm file we used in this function
                                              Kill TempFile
                                          
                                              Set ts = Nothing
                                              Set fso = Nothing
                                              Set TempWB = Nothing
                                              
                                          End Function
                                          

                                          Ma va in errore.

                                          Avresti qualche altro prezioso suggerimento da darmi?

                                          Attendo fiducioso.

                                          Grazie mille.

                                          Saluti,

                                          PDA

                                          #26186 Risposta
                                          tanimon
                                          tanimon
                                          Partecipante
                                            6 pts

                                            ciao Paolo,

                                            non ho il pc e scrivo dal cellulare. 

                                            PDA ha scritto:

                                            Avresti qualche altro prezioso suggerimento da darmi?

                                            tu leggi, ma ricordi solo ciò  che ti fa comodo:

                                            tanimon ha scritto:

                                             

                                            ti consiglio di rileggerti TUTTO il Tread

                                            questa volta rileggilo con più  attenzione. 

                                            Ultima cosa,

                                            andare sull'altro forum vendendo la soluzione come tua,

                                            non è  stato un comportamento "elegante".......

                                            ed Alfredo che saluto, ti ha risposto di conseguenza.

                                            Ciao

                                            Frank

                                            #26188 Risposta
                                            tanimon
                                            tanimon
                                            Partecipante
                                              6 pts

                                              inoltre qui dici di non poter postare il codice completo e dopo un"ora lo posti sull'altro forum? anche gli utenti di questo lo stanno aspettando......

                                              forse speri in un ulteriore aiuto...?

                                              #26206 Risposta

                                              PDA
                                              Partecipante

                                                Ciao Frank,

                                                mi dispiace che il mio involontario atteggiamento abbia causato questa tua reazione.

                                                Ho postato il codice sull'altro forum perché è stato il primo a cui mi sono rivolto ed ho voluto chiudere la discussione.

                                                In merito alla soluzione, ritengo di esserci arrivato da solo, è vero grazie ai tuoi suggerimenti, ma questi ultimi erano indirizzati più e più volte ad utilizzare il codice e le istruzioni che già conoscevo.

                                                Per l'ultima richiesta che ti ho rivolto (copiare il contenuto ed incollarlo come immagine nel corpo della mail) ieri sera ho scritto direttamente a Ron De Bruin che, con mio grande stupore, mi ha risposto dopo circa un'ora invitandomi a visitare questo link:

                                                http://www.rondebruin.nl/win/s1/outlook/bmail0.htm

                                                Quando avrò adattato il codice di Ron De Bruin alla mia esigenza, lo posterò su questo forum e chiuderò la discussione.

                                                A presto.

                                                Saluti,

                                                PDA

                                                #26209 Risposta
                                                tanimon
                                                tanimon
                                                Partecipante
                                                  6 pts

                                                  PDA ha scritto:

                                                   

                                                  In merito alla soluzione, ritengo di esserci arrivato da solo, è vero grazie ai tuoi suggerimenti, ma questi ultimi erano indirizzati più e più volte ad utilizzare il codice e le istruzioni che già conoscevo.

                                                  che però hai applicato solo dopo che io te lo abbia suggerito...

                                                  Molto strano......

                                                   

                                                  comunque pensala come ti pare!

                                                  io farò  altrettanto!!!

                                                  saluti

                                                   

                                                   

                                                  #26212 Risposta
                                                  tanimon
                                                  tanimon
                                                  Partecipante
                                                    6 pts

                                                    al post 26056, tu stesso dicevi di non aver capito il mio suggerimento al post 26049:

                                                    come facevi a conoscerlo se neanche lo capivi.....?

                                                     

                                                    #26223 Risposta

                                                    PDA
                                                    Partecipante

                                                      Ciao Frank,

                                                      allego l'intero codice che il quale ho risolto la mia necessità (non capisco perché mi da problemi a copiarlo in questo post).

                                                      In calce, la funzione di Ron De Bruin con la quale copio una parte del contenuto del file allegato alla mail nel corpo della mail sotto forma di immagine.

                                                      In caso si volesse copiare il range in forma editabile, bisogna utilizzare l'altra funzione di Ron de Bruin (quella del post #25979).

                                                      Grazie mille ancora per avermi dedicato la tua attenzione.

                                                      Alla prossima.

                                                      Saluti,

                                                      PDA

                                                      Allegati:
                                                      You must be logged in to view attached files.
                                                    LoginRegistrati
                                                    Stai vedendo 25 articoli - dal 1 a 25 (di 25 totali)
                                                    Rispondi a: Inserire parte del contenuto dell’allegato nel corpo della mail es. Ron De Bruin
                                                    Gli allegati sono permessi solo ad utenti REGISTRATI
                                                    Le tue informazioni:



                                                    vecchio frac - 2750 risposte

                                                    albatros54
                                                    albatros54 - 997 risposte

                                                    patel
                                                    patel - 889 risposte

                                                    Marius44
                                                    Marius44 - 766 risposte

                                                    Luca73
                                                    Luca73 - 652 risposte