Possibilità di Inserire Frase nella Mail Solo Se Allegato un Determinato File

[PDA PDA]

Ciao a tutti,

con i codici sotto riportati riesco a creare i file "codice cliente.xlsx" dei SOLI codici clienti COMUNI ai fogli PREZZI ed ESTRATTI CONTO, salvandoli sul desktop (macro presente nel Modulo 6).Con la funzione (Modulo 7) allego i file di cui sopra alla specifica mail proprio di quel codice cliente.

Public Function bFound1() As Variant
    
    Dim rAgenti As Range, Cella As Range, totAgenti As Range
    Dim Shc As Worksheet, Shc1 As Worksheet
    Dim uR As Long, ur1 As Long
    Dim myItem As Variant

    Application.ScreenUpdating = False

    Set Shc = ThisWorkbook.Sheets("Estratti Conto")
    Set Shc1 = ThisWorkbook.Sheets("PREZZI")
    uR = Shc.Range("A" & Rows.Count).End(xlUp).Row
    ur1 = Shc1.Range("G" & Rows.Count).End(xlUp).Row
    Set rAgenti = Shc1.Range(Shc1.Cells(8, 7), Shc1.Cells(ur1, 7)) 'Foglio PREZZI
    Set totAgenti = Shc.Range(Shc.Cells(2, 1), Shc.Cells(uR, 1)) 'Foglio ESTRATTI CONTO

    On Error Resume Next
    For Each myItem In rAgenti
        bFound = False
            For Each Cella In totAgenti
                If Cella.Value = CLng(myItem) Then
                    bFound = True
                End If
            Next Cella
    Next myItem
   
    Set Cella = Nothing
    Set Shc = Nothing
    Set Shc1 = Nothing
    
    Application.ScreenUpdating = True
    
End Function

Il grosso problema che sto trovando è che con la seguente istruzione:

If bFound1(Riga) Then


.Attachments.Add (Environ("USERPROFILE") & "\Desktop\" & "Archivio\" & (Foglio1.Cells(Riga, 7).Value & ".xlsx"))
.HTMLBody = Trim(Foglio4.Cells(24, 5)) & accapo & accapo & aStr & accapo & accapo & .HTMLBody
Else
.HTMLBody = aStr & accapo & accapo & .HTMLBody

End If

non riesco ad inserire l'avviso presente nell'apposito foglio (AVVISI) SOLO per le mail che hanno l'allegato "codice cliente.xlsx" (altre mail hanno un altro tipo di allegato) e non a tutte le mail in uscita.

Qualcuno potrebbe aiutarmi?

Grazie mille.

Saluti,
PDA

PS Questo è il link dove ho inserito il file di prova:

https://1drv.ms/f/s!AqPTHQbY5cF7gQHGlLTtq_x4F5ot

[Marius44Moderatore Marius44 Karma: 58 pts]

Ciao

Il file è molto complesso. Fra l'altro non dici quale è il "grosso problema".

Nella riga di codice indicata il problema sorge ogni volta che c'è un  If bFound1(Riga) Then oppure in una specifica riga?

Tuttavia, se ho visto bene, il problema potrebbe essere nel Nome del Foglio dal quale vuoi attingere la frase.

Quando nel codice c'è   Foglio4.Cells(24, 5)  il programma si inceppa perchè non trova il Foglio4 (non mi sembra di aver notato un tale Foglio).

Sei certo di aver indicato il Foglio esatto?

E' una mia supposizione in quanto non posso lanciare la macro per mancanza di altri riferimenti.

Fai sapere. Ciao,

Mario

[albatros54Moderatore albatros54 Karma: 89 pts]

Tuttavia, se ho visto bene, il problema potrebbe essere nel Nome del Foglio dal quale vuoi attingere la frase.

Quando nel codice c’è   Foglio4.Cells(24, 5)

prova ha sostituire"foglio4"; con "sheets("AVVISI")

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente?( Alan Turing)

[PDA PDA]

Salve signori,

scusatemi per il ritardo nella risposta, ma non ho ricevuto alcuna notifica dei vostri post.

Per fortuna (mia) mi sono connesso ora ed ho letto.

Non ho un problema di inceppamento, perché credo di aver settato in modo corretto il riferimento:

Set Foglio4 = ActiveWorkbook.Worksheets("AVVISI")

Piuttosto il mio problema è questo:

riesco ad allegare alle mail gli estratti conto prodotti in precedenza, e solo, come giusto che sia, per quei codici clienti per i quali ci sono estratti conto da elaborare.

Ma ci sono anche clienti che invece non hanno estratti conto da generare, per cui è corretto che non ci sia alcun allegato alla loro mail. E ciò avviene correttamente.

L'avviso presente nel foglio AVVISI deve essere inserito SOLO nelle mail di quei clienti che hanno l'estratto conto in allegato.

Le macro che ho postato, soprattutto la seconda, non risponde perfettamente a questo compito, perché riporta il suddetto avviso in tutte le mail, anche per questi clienti che NON hanno alcun estratto conto generato.

Spero di aver spiegato meglio il mio problema.

Attendo con grande impazienza.

Grazie mille.

Saluti,

PDA

[patelModeratore patel Karma: 51 pts]

Anche a me non piace la riga Set Foglio4 = ActiveWorkbook.Worksheets(“AVVISI”), non costa nulla seguire il consiglio di Albatros o cambiare nome alla variabile, per es Set Avvisi = ActiveWorkbook.Worksheets(“AVVISI”)

[PDA PDA]

Ciao Patel,

non capisco perché non ricevo le notifiche delle vostre risposte.

Comunque ho provato a cambiare il nome, ma il risultato non cambia purtroppo.

Saluti,

PDA

[albatros54Moderatore albatros54 Karma: 89 pts]

sicuramente non ricevi le notifiche perchè non ti sei registrato

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente?( Alan Turing)

[PDAPartecipante PDA]

Appena registrato. Credevo che la spunta qui in basso fosse sufficiente.

Saluti,

PDA

[patelModeratore patel Karma: 51 pts]

Ho scaricato il file allegato, ho modificato il nome utente e cliccato sul pulsante, gira perfettamente, non capisco qual'è il problema.

[PDAPartecipante PDA]

Ciao Patel,

scusami per il ritardo nel riscontro. Spero di riuscire a spiegare il mio problema nel modo più esauriente possibile.

La macro produce 9 mail che partono tutte almeno con un allegato.

SOLO le prime 3 hanno 2 allegati (un estratto conto "codcli.xlsx" + Modulo Ordini - o comunque un qualsiasi altro file sul tuo pc).

Le altre mail hanno un solo allegato: la quarta e quinta hanno solo il file Modulo Ordini ed il resto solo l'estratto conto "codcli.xlsx".

Il mio problema è proprio sulla quarta e quinta mail, perché noterai che viene riprodotto sempre lo stesso messaggio (foglio AVVISI (24, 5)).

Per una questione di precisione, ritengo che questo messaggio non debba essere riportato nelle mail che non hanno in allegato l'estratto conto.

Ti prego di farmi sapere se sono stato abbastanza esaustivo.

Grazie mille per il tempo che mi stai dedicando.

Saluti,

PDA

[patelModeratore patel Karma: 51 pts]

hai allegato un file con molti moduli e molti fogli senza spiegare come il tutto funziona, io clicco sul pulsante verde e vedo creare una cartella con dei file, non avendo io outlook installato dovrebbe dare errore e non lo fa. Come vedi nessuno ti risponde perché non ha voglia di diventar matto a capire

[PDAPartecipante PDA]

Quello è il file originario e nel mio primo post ho indicato i moduli di riferimento, con anche il codice relativo.

Il mio progetto è molto complesso e nel corso degli anni si è sviluppato sempre di più.

A questo punto credo che il problema sia nella funzione al modulo 7, che non gira a dovere...

Saluti,

PDA

[PDAPartecipante PDA]

Ciao Patel,

sto provando a fare un altro tipo di approccio al problema.

Sto cercando di modificare il codice al Modulo 6, che è quello che mi consente di creare i file con nome dato dal codice numerico del cliente e l'estensione .xlsx.

Ho scritto un'istruzione:

uR3 = Shc1.Range("AD" & Rows.Count).End(xlUp).Row
Set rAgenti2 = Shc1.Range(Shc1.Cells(8, 30), Shc1.Cells(uR3, 30)) 'Foglio PREZZI colonna AD

Ma non riesco a capire dove inserire quest'altra istruzione:

rAgenti2.Value = "X"

Il mio scopo adesso è quello di fare in modo che nella colonna AD del foglio PREZZI venga inserita una "X" SOLO in corrispondenza di quei codici clienti per i quali è stato generato il file.

Il riscontro credo sia più veloce e semplice rispetto a prima.

Bisogna considerare solo i moduli 6 (EstraiFile) e 7 (funzione bFound).

Il codice principale si trova al Foglio1 (PREZZI), ma in questa fase non occorre analizzarlo poiché è sufficiente che la macro giri fino alla generazione dei file per poter verificare se la "X" viene inserita in modo corretto.

Il problema che ho riscontrato è che, per come ho inserito le due istruzioni sopra riportate, la "X" appare dalla riga 1 in poi.

Public Sub EstraiFile()

Dim Elenco As Collection
Dim Agente As Variant
Dim rAgenti As Range, Cella As Range, totAgenti As Range, rAgenti2
Dim Shc As Worksheet, Shc1 As Worksheet, Shc2 As Worksheet
Dim NewWK As Workbook
Dim sRigaBis As Long, uR As Long, ur1 As Long
Dim myItem As Variant
Dim bFound As Boolean
Dim uR2 As Long, iR As Long, uR3 As Long
Dim iStart As Long, iEnd As Long
Dim Expire As Boolean

Application.ScreenUpdating = False
Set Elenco = New Collection
Set Shc = ThisWorkbook.Sheets("Estratti Conto")
Set Shc1 = ThisWorkbook.Sheets("PREZZI")
uR = Shc.Range("A" & Rows.Count).End(xlUp).Row
ur1 = Shc1.Range("G" & Rows.Count).End(xlUp).Row
Set rAgenti = Shc1.Range(Shc1.Cells(8, 7), Shc1.Cells(ur1, 7)) 'Foglio PREZZI colonna G
Set totAgenti = Shc.Range(Shc.Cells(2, 1), Shc.Cells(uR, 1)) 'Foglio ESTRATTI CONTO

uR3 = Shc1.Range("AD" & Rows.Count).End(xlUp).Row
Set rAgenti2 = Shc1.Range(Shc1.Cells(16, 30), Shc1.Cells(uR3, 30)) 'Foglio PREZZI colonna AD

On Error Resume Next
For Each Agente In rAgenti 'per ciascun codice agente del foglio Prezzi
If Agente.Value <> "" Then
Elenco.Add Agente.Value 'aggiungilo ad Elenco
'rAgenti2.Value = "X"
Else: Agente = Agente + 1
End If
Next Agente

On Error Resume Next
MkDir (Environ("USERPROFILE") & "\Desktop\" & "Archivio")
On Error GoTo 0
For Each myItem In Elenco
bFound = False
sRigaBis = 2
For Each Cella In totAgenti
If Cella.Value = CLng(myItem) Then
If bFound = False Then
Set NewWK = Workbooks.Add
With NewWK.Sheets(1)
.Range("A1:K1").Value = Array( _
"Codice Cliente", "Ragione Sociale", "Tipo di Documento", _
"Data Emissione", "Data Scadenza Fattura", _
"Giorni di Ritardo", "Tipo di Fattura", "Numero di Fattura", _
"Riferimento", "Importo in €", "TOTALE")
.Range("A1:K1").Select
End With
Selection.Font.Bold = True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With

Selection.AutoFilter
Range("A2").Select
ActiveWindow.FreezePanes = True

Rows("1:1").Select

Selection.Locked = False
Selection.FormulaHidden = False

With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

Selection.RowHeight = 32.25
Columns("A:A").ColumnWidth = 9.86
Columns("B:B").ColumnWidth = 11.71
Columns("C:C").ColumnWidth = 8.86
Columns("C:C").ColumnWidth = 11
Columns("D:D").ColumnWidth = 12.43
Columns("E:E").ColumnWidth = 16.86
Columns("E:E").ColumnWidth = 14.29
Columns("F:F").ColumnWidth = 9.71
Columns("G:G").ColumnWidth = 8.86
Columns("H:K").ColumnWidth = 15

End If
bFound = True
Cella.EntireRow.Copy NewWK.Sheets(1).Cells(sRigaBis, 1)
sRigaBis = sRigaBis + 1
End If
Next Cella

NewWK.Sheets(1).Range("A1").Select
NewWK.Sheets(1).Columns("B:B").EntireColumn.AutoFit

If bFound Then

Call InserisciTotali

On Error Resume Next
Application.DisplayAlerts = False

NewWK.SaveAs Filename:=(Environ("USERPROFILE") & "\Desktop\" & "Archivio\" & myItem)
Application.DisplayAlerts = True
NewWK.Close

'rAgenti2.Value = "X"

End If
Next myItem
'rAgenti2 = rAgenti2 + 1

If bFound Then
rAgenti2.Value = "X"
End If

Set NewWK = Nothing
Set Elenco = Nothing
Set Cella = Nothing
Set Shc = Nothing
Application.ScreenUpdating = True

End Sub

Mentre invece dovrebbe essere inserita a partire dalla riga 8 e SOLO per quei codici che generano il file "codicecliente.xlsx".

Credi sia più fattibile questa strada?

Attendo tue gradite notizie.

Grazie mille.

Saluti,

PDA

[albatros54Moderatore albatros54 Karma: 89 pts]

Il problema che ho riscontrato è che, per come ho inserito le due istruzioni sopra riportate, la “X” appare dalla riga 1 in poi.

inserisci la riga evidenziata nel tuo codice,

If Agente.Value <> "" Then
            Elenco.Add Agente.Value    'aggiungilo ad Elenco
            'rAgenti2.Value = "X"
            Cells(Agente.Row, "AD") = "X"
        Else: Agente = Agente + 1
        End If

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente?( Alan Turing)

[PDAPartecipante PDA]

Ciao Albatros54,

grazie mille.

Almeno una cosa per ora è risolta.

Purtroppo resta ancora il problema più grande:

la "X" nella colonna AD deve essere inserita SOLO in corrispondenza di quei codici clienti per i quali è stato creato il relativo file.

Credo che il problema sia nella funzione presente nel modulo 7 (bFound).

Riusciresti a darmi qualche altro suggerimento?

Grazie mille.

Saluti,

PDA

[albatros54Moderatore albatros54 Karma: 89 pts]

nella routine del modulo6 "estraifile",inserisci queste righe di codice che non fanno altro che inserire una X solo quando viene creato il file,naturalmente devi poi adattare il Range("g6:g20"), se ho capito

 Call InserisciTotali

            On Error Resume Next
            Application.DisplayAlerts = False

            NewWK.SaveAs Filename:=(Environ("USERPROFILE") & "\Desktop\" & "Archivio\" & myItem)

            Application.DisplayAlerts = True
            NewWK.Close
            Set rgtrovato = Range("g6:g20").Find(myItem)
            trovato = rgtrovato.Row
            Shc1.Cells(trovato, "AD") = "X"
        End If
    Next myItem

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente?( Alan Turing)

[PDAPartecipante PDA]

Albatros54 sei un MITO!

Grazie mille.

Ho lavorato fino ad ora per adattarlo alle mie esigenze ed al file che uso tutti i giorni.

A presto (ne ho di cose da sviluppare).

PS Come faccio per RISOLVERE la discussione?

Saluti,

PDA

[albatros54Moderatore albatros54 Karma: 89 pts]

In fondo a questa pagina a sx combobox seleziona risolto click su aggiorna
Ciao

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente?( Alan Turing)

[PDAPartecipante PDA]

Scusami, ma non trovo nessuna combobox.

Com'è possibile?

[albatros54Moderatore albatros54 Karma: 89 pts]

ti allego immagine, se trovi difficolta' lo posso inserire io
ciao

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente?( Alan Turing)

Allegati:

You must be logged in to view attached files.

[PDAPartecipante PDA]

Ti allego l'immagine della schermata che mi appare.

Continuo a non trovarla.

Se puoi farlo tu, te ne sarei grato.

Grazie mille.

Saluti,

PDA

Allegati:

You must be logged in to view attached files.

[albatros54Moderatore albatros54 Karma: 89 pts]

Fatto! !

[PDAPartecipante PDA]

Grazie mille.

Saluti,

PDA

[Autore]

Articoli