Skip to main content
Support is Offline
Today is our off day. We are taking some rest and will come back stronger tomorrow
Official support hours
Monday To Friday
From 09:00 To 17:30
  Sunday, 31 January 2021
  0 Replies
  1.6K Visits
0
Votes
Undo
salve scusate sono nuovo e non molto bravo con macro e vba.
Ho seguito una vostra discussione sull'invio automatico di una email su scadenza di una data.
ho fatto mille prove con vari metodi e varie macro ma l'email cambiando data di scadenza non viene Inviata.
Inserisco quella che ho trovato , ma anche quella conj le colonne già preimpostate non mi funziona.

Public
Sub
CheckAndSendMail()

'Updated by Extendoffice 2018/11/22

    
Dim
xRgDate 
As
Range

    
Dim
xRgSend 
As
Range

    
Dim
xRgText 
As
Range

    
Dim
xRgDone 
As
Range

    
Dim
xOutApp 
As
Object

    
Dim
xMailItem 
As
Object

    
Dim
xLastRow 
As
Long

    
Dim
vbCrLf 
As
String

    
Dim
xMailBody 
As
String

    
Dim
xRgDateVal 
As
String

    
Dim
xRgSendVal 
As
String

    
Dim
xMailSubject 
As
String

    
Dim
As
Long

    
On
Error
Resume
Next

    
Set
xRgDate = Application.InputBox(
"Please select the due date column:"
"KuTools For Excel"
, , , , , , 8)

    
If
xRgDate 
Is
Nothing
Then
Exit
Sub

    
Set
xRgSend = Application.InputBox(
"Please select the recipients?email column:"
"KuTools For Excel"
, , , , , , 8)

    
If
xRgSend 
Is
Nothing
Then
Exit
Sub

    
Set
xRgText = Application.InputBox(
"Select the column with reminded content in your email:"
"KuTools For Excel"
, , , , , , 8)

    
If
xRgText 
Is
Nothing
Then
Exit
Sub

    
xLastRow = xRgDate.Rows.count

    
Set
xRgDate = xRgDate(1)

    
Set
xRgSend = xRgSend(1)

    
Set
xRgText = xRgText(1)

    
Set
xOutApp = CreateObject(
"Outlook.Application"
)

    
For
i = 1 
To
xLastRow

        
xRgDateVal = 
""

        
xRgDateVal = xRgDate.Offset(i - 1).Value

        
If
xRgDateVal <> 
""
Then

        
If
CDate
(xRgDateVal) - 
Date
<= 7 
And
CDate
(xRgDateVal) - 
Date
> 0 
Then

            
xRgSendVal = xRgSend.Offset(i - 1).Value

            
xMailSubject = xRgText.Offset(i - 1).Value & 
" on "
& xRgDateVal

            
vbCrLf = 
"<br><br>"

            
xMailBody = 
"<HTML><BODY>"

            
xMailBody = xMailBody & 
"Dear "
& xRgSendVal & vbCrLf

            
xMailBody = xMailBody & 
"Text : "
& xRgText.Offset(i - 1).Value & vbCrLf

            
xMailBody = xMailBody & 
"</BODY></HTML>"

            
Set
xMailItem = xOutApp.CreateItem(0)

            
With
xMailItem

                
.Subject = xMailSubject

                
.
To
= xRgSendVal

                
.HTMLBody = xMailBody

                
.Display

                
'.Send

            
End
With

            
Set
xMailItem = 
Nothing

        
End
If

    
End
If

    Next    

Set
xOutApp = 
Nothing

End
Sub

Ho capito che con questo metodo ogni volta ti chiede di inserire i dati e se c'è il criterio di scadenza lui apre OutLooc e poi ti fà vedere tutte le memail che sono in scadenza e cliccando una per volta le invii.

poi ne ho vista una che inserendo già le caselle preinpostate per esempio da F7:F100 in sieme ha commento ecc, ma anche questa spostando la data di scadenza simulando che scade entro i 7g non viene avviata.
Ora mi chiedo:
C'è la possibilità di avere nel momento in cui io ho aperto Exell che tale email in scadenza vengono inviate automaticamente senza che io vado a guardare la scadenza ecc
Esempio :

Grazie delvostro aiuto.
There are no replies made for this post yet.