+ Rispondi al Thread
Visualizzazione dei risultati da 1 a 4 su 4

Discussione: procedura invio mail che si interrompe se manca file di attachment dichiarato

  1. #1
    L'avatar di Tommy_G
    Tommy_G non è in linea Scribacchino
    Post
    989

    procedura invio mail che si interrompe se manca file di attachment dichiarato

    buongiorno a tutti, da una sub faccio eseguire il merge di un documento pdf (creato da report con outputTo) ad un altro file pdf presente in una determinata cartella su disco di rete, quindi a seguire lancio la function a seguire che prevede la creazione di una email con i relativi allegati
    codice:
    Dim Fax_A           As String
    Dim Fax_B           As String
    Dim Mail_1          As String
    Dim sOggetto        As String
    Dim sMaster         As String
    Dim sJpgChild       As String
    Dim sJpgChild_R     As String
    Dim sChild          As String
    Dim sChild_R        As String
    Dim olFormatHTML    As String
    Dim OutApp          As Object
    Dim OutMail         As Object
    Dim sCorpoTesto     As String
    Dim Riga1           As String
    Dim Riga2           As String
    
    Riga1 = "<font color=Black face='Calibri'><span style='font-size:11.0pt;'><b></span></font>" & _
            "<font color=Black face='Calibri'><span style='font-size:10.0pt;'><br>Direzione Amministrazione<br>Controllo di Gestione e Operations</span></font><br>" & _
            "<font color=Black face='Calibri'><span style='font-size:9.0pt;'><i>Incassi e Pagamenti</i></b></span></font><br>" & _
            "<font color='#B20000' face='Arial Black'>" & _
            "<span style='font-size:10.0pt;'>XXXXXXXXXXi S.p.A.</span></font>" & _
            "<font color=Black face='Calibri'><span style='font-size:9.0pt;'><br>Via , 15" & _
            "<br>XXXX XXXXX<br></span></font>"
    
            
    Riga2 = "<pre><font color=Black face='Calibri'><span style='font-size:9.0pt;'>Tel.:	011.XXXXX<br>" & _
                  "Fax:	011.XXXXX<br>" & _
                  "E-mail:	<a href='mailto:XXXXi@XXXX.it'>Box-Incassi e Pagamenti<br><a>" & _
                  "Sito web:	<a href='http://www.XXXXX.it'>www.XXXX.it</span></font></pre><a>"
    
    '---------
    
    If Forms!inserimento_dati.CasellaCombinata91 = "si" Then
    sCorpoTesto = ""
    Else
    sCorpoTesto = " >> SI PREGA DI COMUNICARE IN OGNI CASO ALL'UFFICIO SCRIVENTE L'ESITO DELLA VOSTRA RICHIESTA, SIA CHE ESSA COMPORTI UN NUOVO PAGAMENTO, SIA CHE SI RIVELI UN INCASSO REGOLARE << "
    End If
    
    If InStr(1, Forms!inserimento_dati.Note, "PRESCRIZIONE DEI TERMINI") > 0 Then
    sCorpoTesto = sCorpoTesto & "<br>" & "<br><font size=5>" & "NOTA BENE!" & "</font><br>" & "Dal momento che sono trascorsi più di 2 anni dall'emissione del titolo, vi preghiamo di verificare se sussiste un eventuale ''prescrizione dei termini'' (2 anni dal fatto o dall'ultimo atto dell'assicurato, idoneo ad interrompere la prescrizione del suo diritto, vedi articoli 2947 - 2952 del Codice Civile)." & "<br>" & _
    "In presenza di un atto di transazione (quale ad es. una quietanza firmata da entrambe le parti) o di una sentenza di condanna passata in giudicato, il termine del diritto al pagamento è elevato a 10 anni (art. 1965 - 2953 del Codice Civile)."
    End If
    
    
    
    sOggetto = "Comunicazioni" & (" in relazione all'assegno n. " & Forms!inserimento_dati.Numero_assegno & " del " & Forms!inserimento_dati.Data_emissione & " di EURO " & Forms!inserimento_dati.Importo & " a nome di " & Forms!inserimento_dati.Beneficiario & " SX n. " & Forms!inserimento_dati.Sinistro & " società " & Forms!inserimento_dati.Società)
    sMaster = "M:\Archivi vari\Mezzi di Pagamento\PDF\Ass_" & Forms!inserimento_dati.Numero_assegno & ".pdf"
    sChild = "M:\Archivi vari\Mezzi di Pagamento\PDF\" & Forms!inserimento_dati.Numero_assegno & ".pdf"
    sChild_R = "M:\Archivi vari\Mezzi di Pagamento\PDF\" & Forms!inserimento_dati.Numero_assegno & "R" & ".pdf"
    
    sJpgChild = "M:\Archivi vari\Mezzi di Pagamento\PDF\" & Forms!inserimento_dati.Numero_assegno & ".jpg"
    sJpgChild_R = "M:\Archivi vari\Mezzi di Pagamento\PDF\" & Forms!inserimento_dati.Numero_assegno & "R" & ".jpg"
    
    
    Mail_1 = "M:\Archivi vari\Mezzi di Pagamento\PDF\Ass_" & Forms!inserimento_dati.Numero_assegno & ".pdf"
    
    '-----------------------------------------
    If Not IsNull(Forms!inserimento_dati.Testo4) And InStr(1, Forms!inserimento_dati.Testo4, "@") <= 0 Then
    Fax_A = Replace(Forms!inserimento_dati.Testo4, "-", vbNullString)
    Fax_A = Replace(Fax_A, "/", vbNullString)
    Fax_A = Replace(Fax_A, ".", vbNullString)
    Fax_A = Replace(Fax_A, " ", vbNullString)
    Fax_A = Replace(Fax_A, "*", vbNullString)
    Fax_A = Replace(Fax_A, "'", vbNullString)
    Fax_A = Fax_A & "@fax.gfs.net"
    End If
    
    If Not IsNull(Forms!inserimento_dati.Fax_Terzi) And InStr(1, Forms!inserimento_dati.Fax_Terzi, "@") <= 0 Then
    Fax_B = Replace(Forms!inserimento_dati.Fax_Terzi, "-", vbNullString)
    Fax_B = Replace(Fax_B, "/", vbNullString)
    Fax_B = Replace(Fax_B, ".", vbNullString)
    Fax_B = Replace(Fax_B, " ", vbNullString)
    Fax_B = Replace(Fax_B, "*", vbNullString)
    Fax_B = Replace(Fax_B, "'", vbNullString)
    Fax_B = Fax_B & "@fax.gfs.net"
    End If
    
    If Not IsNull(Forms!inserimento_dati.Testo2) And InStr(1, Forms!inserimento_dati.Testo4, "@") > 0 Then
    Fax_A = Forms!inserimento_dati.Testo4
    End If
    
    If Not IsNull(Forms!inserimento_dati.Data_richiesta_terzi) And InStr(1, Forms!inserimento_dati.Fax_Terzi, "@") > 0 Then
    Fax_B = Forms!inserimento_dati.Fax_Terzi
    End If
    
    '------------------------------------------
    
            Set OutApp = CreateObject("Outlook.Application")
            OutApp.Session.Logon
            Set OutMail = OutApp.CreateItem(0)
            
            On Error Resume Next
            
    With OutMail
            
            .To = Fax_A
            .CC = Fax_B
            .Subject = Replace(sOggetto, "*", "_")
            .BodyFormat = olFormatHTML
            .HTMLbody = "<html><body><font color=Black face='Calibri'><span style='font-size:11.0pt;'>" & sCorpoTesto & "Vedi comunicazioni in allegato<br>Saluti.<br>" & Riga1 & Riga2 & "</span></font></body></html>"
            .Attachments.Add Mail_1
            .Attachments.Add sJpgChild
            .Attachments.Add sJpgChild_R
        Set .SendUsingAccount = OutApp.Session.Accounts.Item(2)
            .OriginatorDeliveryReportRequested = True
            .Display
    End With
            On Error GoTo 0
            Set OutMail = Nothing
            Set OutApp = Nothing
    
    Dim SourceFiles_sChild      As String
    Dim SourceFiles_sChild_R    As String
    Dim SourceFile_sJpgChild    As String
    Dim SourceFile_sJpgChild_R  As String
    Dim DestinationFile         As String
    Dim DestinationFileFrontJpg As String
    Dim DestinationFileRearJpg  As String
    Dim Unisci                  As String
    
    SourceFiles_sChild = sChild
    SourceFiles_sChild_R = sChild_R
    SourceFile_sJpgChild = sJpgChild
    SourceFile_sJpgChild_R = sJpgChild_R
    
    If Len(Dir(SourceFiles_sChild_R)) > 0 And Len(Dir(SourceFiles_sChild)) > 0 Then
        Unisci = MergePDFDocuments(SourceFiles_sChild, SourceFiles_sChild_R)
        DestinationFile = "M:\Archivi vari\Mezzi di Pagamento\PDF\PDF_Pervenuti\" & Forms!InviaPDF.Numero_assegno & ".pdf"
        FileCopy SourceFiles_sChild, DestinationFile
    Else
        If Len(Dir(SourceFiles_sChild)) > 0 Then
        DestinationFile = "M:\Archivi vari\Mezzi di Pagamento\PDF\PDF_Pervenuti\" & Forms!InviaPDF.Numero_assegno & ".pdf"
        FileCopy SourceFiles_sChild, DestinationFile
    End If
    End If
    
    If Len(Dir(SourceFile_sJpgChild_R)) > 0 And Len(Dir(SourceFile_sJpgChild)) > 0 Then
        DestinationFileFrontJpg = "M:\Archivi vari\Mezzi di Pagamento\PDF\PDF_Pervenuti\" & Forms!InviaPDF.Numero_assegno & ".Jpg"
        DestinationFileRearJpg = "M:\Archivi vari\Mezzi di Pagamento\PDF\PDF_Pervenuti\" & Forms!InviaPDF.Numero_assegno & "R.Jpg"
        FileCopy SourceFile_sJpgChild, DestinationFileFrontJpg
        FileCopy SourceFile_sJpgChild_R, DestinationFileRearJpg
            'MsgBox DestinationFileFrontJpg & vbNewLine & DestinationFileRearJpg
    Else
        DestinationFile = "M:\Archivi vari\Mezzi di Pagamento\PDF\PDF_Pervenuti\" & Forms!InviaPDF.Numero_assegno & ".Jpg"
        If Len(Dir(SourceFile_sJpgChild)) > 0 Then
        FileCopy SourceFile_sJpgChild, DestinationFile
    End If
    End If
    
    If Len(Dir(sMaster)) > 0 Then Kill sMaster
    If Len(Dir(sChild)) > 0 Then Kill sChild
    If Len(Dir(sChild_R)) > 0 Then Kill sChild_R
    
    If Len(Dir(sJpgChild)) > 0 Then Kill sJpgChild
    If Len(Dir(sJpgChild_R)) > 0 Then Kill sJpgChild_R
    succede che se vengono a mancare gli allegati (anche solo uno su tre) la procedura si interrompe, cosa che invece non accadeva prima che installassimo a tutti gli utenti office 2016.
    nel caso specifico risolverò eliminando la parte di script che prevede che vengano allegati anche i due file jpg (cosa che avveniva in passato ma ora non più) tuttavia ho un caso simile dove invece si presentano 2 possibili allegati (che a volte ci sono a volte no) in questo secondo caso ho momentaneamente aggiustato scrivendo 3 volte la medesima istruzione all'interno della function, una per ogni possibile circostanza che viene a crearsi.
    è normale tutto ciò? ovvero, per quale motivo a jet interessa che alle variabili dei tre attachment corrispondano tre "reali file" ( un pdf e due jpg) nel percorso dichiarato? basta infatti commentare la stringa dei due jpg perchè tutto funzioni regolarmente
    Ultima modifica di Tommy_G; 06-05-2019 16:12 

  2. #2
    L'avatar di @Alex
    @Alex non è in linea Very Important Person
    Post
    15,997
    Puoi spiegare meglio come può accadere che manchino gli allegati...?
    Immagino che prima di usare il metodo [.Attachments.Add] tu controlli la presenza del File... se non lo fai è un errore, perchè prima andasse... non saprei:
    codice:
    If FileExist(Mail_1) Then .Attachments.Add Mail_1
    If FileExist(sJpgChild) Then .Attachments.Add sJpgChild
    If FileExist(sJpgChild_R) Then .Attachments.Add sJpgChild_R
    Non interessa a JET ma probabilmente all'oggetto MSO...!
    Ho frasinteso qualche cosa...?

    Invece di fare N Replace, non cambia nulla in termini di Velocità ma accentri la Funzione di STRIP:

    codice:
    Public Function StripChar(StringIn As String, Optional Pattern) As String
        Dim i           As Integer
        Dim strOut      As String
        Const cRemoveChar = "-/. *'"
    
        If IsMissing(Pattern) Then Pattern = cRemoveChar
        strOut = StringIn
        For i = 1 To Len(Pattern)
            Debug.Print Mid$(Pattern, i, 1)
            strOut = Replace(strOut, Mid$(Pattern, i, 1), vbNullString)
        Next
        
        StripChar = strOut
    End Function
    Quindi nel tuo caso sarebbe
    codice:
    '-----------------------------------------
    If Not IsNull(Forms!inserimento_dati.Testo4) And InStr(1, Forms!inserimento_dati.Testo4, "@") <= 0 Then
        Fax_A = StripChar(Forms!inserimento_dati.Testo4) & "@fax.gfs.net"
    End If
    
    If Not IsNull(Forms!inserimento_dati.Fax_Terzi) And InStr(1, Forms!inserimento_dati.Fax_Terzi, "@") <= 0 Then
       Fax_A = StripChar(Forms!inserimento_dati.Fax_Terzi) & "@fax.gfs.net"
    End If
    Se poi cambi i criteri li cambi nella sola Funzione.
    Ultima modifica di @Alex; 06-05-2019 17:06 
    @Alex
    Il CROSSPOST è VIETATO
    Mirror al vecchio sito WEB(salvare i Demo riassegnando l'estensione (.Zip/.Rar/.Exe in base all'icona...):
    http://mirror.masterdrive.it/alessandrobaraldi/
    Leggi il
    Regolamento del Forum e nel comprenderne la filosofia rispettalo.

  3. #3
    Phil_cattivocarattere non è in linea Scribacchino
    Luogo
    Verona-Mantova
    Post
    1,649
    Quote Originariamente inviato da Tommy_G Visualizza il messaggio
    codice:
    ...        
            On Error Resume Next
            
    With OutMail
            
            .To = Fax_A
    ...
            .Attachments.Add Mail_1
            .Attachments.Add sJpgChild
            .Attachments.Add sJpgChild_R
    ...
    End With
            On Error GoTo 0
    succede che se vengono a mancare gli allegati (anche solo uno su tre) la procedura si interrompe, cosa che invece non accadeva prima che installassimo a tutti gli utenti office 2016.
    Si interrompe anche se in presenza di On Error Resume Next?
    Considerato che il sistema migliore è comunque quello indicato da @Alex, cioè allegare il file dopo aver verificato che esista, a puro titolo di test potresti sposatare il resume next immediatamente prima di aggiungere gli allegati per tornare subito dopo a GoTo 0 e vedere come reagisce?
    codice:
    ...
            'On Error Resume Next
            
    With OutMail
    ...
            On Error Resume Next
            .Attachments.Add Mail_1
            .Attachments.Add sJpgChild
            .Attachments.Add sJpgChild_R
            On Error GoTo 0
    ...
    End With
            'On Error GoTo 0
    Hai altra gestione degli errori nel modulo? L'invio poi lo fai "a mano"? non vedo .Send da nessuna parte. (questa è solo curiosità).
    Solitamente outlook è già in funzione? Questa procedura è all'interno di un ciclo o comunque viene eseguita più e più volte o è "singola"? Sto cercando di evidenziare tutte quelle situazioni che potrebbero influire su questo "strano comportamento" (anche se lo strano potrebbe essere il fatto che prima del passaggio ad office 2016 tutto funzionasse senza problemi)

  4. #4
    L'avatar di Tommy_G
    Tommy_G non è in linea Scribacchino
    Post
    989
    allora, per rispondere a Phil, spostare il resume next all'interno del ciclo with non sortisce nessun effetto. riguardo l'email faccio eseguire solo il display poi l'invio lo fa l'utente che potrà così apportare eventuali modifiche/aggiunte al corpo email. non ho altra gestione degli errori ma provvedo ora (è un db vecchissimo con molti script ai tempi fatti un po' a c....) si, outlook è già in funzione , la procedura è singola.
    Vai a sapere perchè con office 2010 andava, ciomunque, ho risolto grazie al suggerimento di Alex, ovviamente creando l'apposita function che viene richiamata alla bisogna:
    codice:
    Public Function FileExist(ByVal str As String) As Boolean
        On Error Resume Next
        FileExist = (GetAttr(str) And vbDirectory) = 0
    End Function
    ringrazio Alex per la function molto funzionale per eseguire i replace!

+ Rispondi al Thread

Permessi di invio

  • Non puoi inserire discussioni
  • Non puoi inserire repliche
  • Non puoi inserire allegati
  • Non puoi modificare i tuoi messaggi