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
Your time
Wednesday, —: —: —
Our time
Wednesday, 18: 19: 02
New

Invio email automaticamente alla scadenza data .

  Excel
futaba2
  futaba2
  Sunday, 31 January 2021
  0 Replies
  2.5K Visits
0
Votes
Undo 
Salve ha tutti sono nuovo è poco pratico di VBA e macro,

ho provato questa formula e altre per inviare una email automaticamente in scadenza di una data.

ma non funziona.

sbaglio sicuramente qualcosa.

Mi può aiutare qualcuno.

ho eseguito come detto varie prove prese su questo forum ma nulla non funzionano.

poi vorrei sapere se questa macro deve calcolare la data di scadenza, deve capire la data odierna , che sicuramente deve essere scritta in una riga di questa vba vero?

Grazie per l'aiuto saluti.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
i 
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
0
There are no replies made for this post yet.