Grazie mille!!! Provo!!!
Ciao
Moderatori: Anthony47, Flash30005
Sub myPROC(ByRef myMex As MailItem, ByVal SJadd As String, ByVal MAILtxt As String, ByRef proCd As MAPIFolder)
Set myReply = myMex.ReplyAll
myReply.Subject = myMex.Subject & SJadd
myReply.Body = MAILtxt & myReply.Body
' myReply.Send
myReply.Display
myWait (0.3)
myMex.Move proCd
myWait (0.2)
End Sub
Sub RepSel2()
'Vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=107024&p=638054#p638054
Dim daProc As MAPIFolder, proCd As MAPIFolder
Dim myNameSpace As NameSpace, myMex As MailItem, myReply As MailItem
Dim SJadd As String, MAILtxt As String, I As Long
'
SJadd = " - autoanswer by macro" '<<< Un testo da accodare nel Subject
'Composizione del testo della Risposta (esempio): '<<< Composizione del testo
MAILtxt = "Cari amici, sapete gia' che fare " & vbCrLf
MAILtxt = MAILtxt & "Firmato: Enrico" & vbCrLf
MAILtxt = MAILtxt & "Non telefonatemi" & vbCrLf
'
Set myNameSpace = Application.GetNamespace("MAPI")
'Set daProc = myNameSpace.Folders("Cartelle personali").Folders("Posta in arrivo").Folders("DaProcessare") '<<<Folder di origine
Set proCd = myNameSpace.Folders("Cartelle personali").Folders("Posta in arrivo").Folders("Processate") '<<< Folder si destinazione
'
Dim sMail As Single
Select Case TypeName(Application.ActiveWindow)
Case "Explorer"
sMail = Application.ActiveExplorer.Selection.Count
Case "Inspector"
sMail = 0.1
Case Else
End Select
'
If sMail >= 1 Then
For Each myMex In Application.ActiveExplorer.Selection
If TypeOf myMex Is MailItem Then
Call myPROC(myMex, SJadd, MAILtxt, proCd)
I = I + 1
End If
Next myMex
ElseIf sMail > 0 Then
Set myMex = Application.ActiveInspector.CurrentItem
If TypeOf myMex Is MailItem Then
Call myPROC(myMex, SJadd, MAILtxt, proCd)
I = I + 1
End If
End If
On Error Resume Next
myMex.Close olDiscard
Application.ActiveInspector.Close olDiscard
On Error GoTo 0
MsgBox ("Completato; (" & I & " messaggi)")
End Sub
=SE(F7="";"";CERCA.VERT(F7;A2:C12;3;FALSO))
risposta_Select = Foglio1.Cells(10, 6).Value
MAILtxt = Foglio1.Cells(10, 6).Value
myReply.Body = MAILtxt & myReply.Body
'Allega il primo file: file.doc
Dim MyFileName As String
Dim MyFileAttacments As String
MyFileName = "file.doc"
MyFileAttacments = "C:\miadirectory\" & MyFileName & ""
With myReply
.Attachments.Add MyFileAttacments
End With
'Allega il secondo: file.xls
Dim MyFileNameOriginale As String
Dim MyFileAttacmentsOriginale As String
MyFileNameOriginale = "File.xls"
MyFileAttacmentsOriginale = "C:\miadirectory\" & MyFileNameOriginale & ""
With myReply
.Attachments.Add MyFileAttacmentsOriginale
End With
Option Explicit
Dim y As Integer
Dim blnTrovato As Boolean
Dim I As Integer
Dim blnCancella As Boolean
Dim intRisposta As Integer
Dim blnAggiorna As Boolean
Dim x As Integer
Private Sub chkFolder_Click()
' attivo e disattivo la casella di testo txtFolder2 al clic sulla rispettiva checkbox
If chkFolder.Value = True Then
txtFolder2.Enabled = True
lblFolder2.Enabled = True
Else
txtFolder2.Enabled = False
lblFolder2.Enabled = False
End If
End Sub
Private Sub chkTestoEmail_Click()
' attivo e disattivo la casella di testo txtTestoEmail2 al clic sulla rispettiva checkbox
If chkTestoEmail.Value = True Then
txtTestoEmail2.Enabled = True
lblTestoEmail2.Enabled = True
Else
txtTestoEmail2.Enabled = False
lblTestoEmail2.Enabled = False
End If
End Sub
Private Sub cmdAggiornaCodice_Click()
' controllo che non siano dati vuoti e che i dati siano del TestoEmail che mi serve
If txtFolder2.Text = "" Then
MsgBox "Attenzione! Visualizza i dati prima della modifica!"
txtFolder2.Enabled = True
txtFolder2.SetFocus
Exit Sub
ElseIf IsNumeric(txtFolder2.Text) Then
MsgBox "Attenzione! Specifica un Folder"
txtFolder2.Enabled = True
txtFolder2.SetFocus
Exit Sub
ElseIf txtTestoEmail2.Text = "" Then
MsgBox "Attenzione! Visualizza i dati prima della modifica!"
txtTestoEmail2.Enabled = True
txtTestoEmail2.SetFocus
Exit Sub
ElseIf IsNumeric(txtTestoEmail2.Text) Then
MsgBox "Attenzione! Specifica un TestoEmail"
txtTestoEmail2.Enabled = True
txtTestoEmail2.SetFocus
Exit Sub
Exit Sub
End If
blnAggiorna = False
x = 1
Do Until blnAggiorna = True Or x = Range("A1").CurrentRegion.Rows.Count
If Range("A" & x) = txtCodiceRegola2.Text Then
intRisposta = MsgBox("Sei sicuro di voler aggiornare la regola e-mail con CodiceRegola " & txtCodiceRegola2.Text & "?", vbYesNo, "Attenzione!")
If intRisposta = vbYes Then
'scrivo nel foglio excel
Range("B" & x) = txtFolder2.Text
Range("C" & x) = txtTestoEmail2.Text
'correggo i dati anche nell'altra pagina
txtFolder.Text = txtFolder2.Text
txtTestoEmail.Text = txtTestoEmail2.Text
MsgBox "La regola e-mail " & txtCodiceRegola2.Text & " è stata aggiornata"
End If
blnAggiorna = True
End If
x = x + 1
Loop
End Sub
Private Sub cmdAggiungiRegola_Click()
Dim h As Integer
Dim blnAggiungi As Boolean
' controllo che non siano dati vuoti
If txtCodiceRegola3.Text = "" Then
MsgBox "Attenzione! Non hai impostato un valore nella casella Regola e-mail!"
txtCodiceRegola3.SetFocus
Exit Sub
ElseIf txtFolder3.Text = "" Then
MsgBox "Attenzione! Non hai impostato un valore nella casella Folder!"
txtFolder3.SetFocus
Exit Sub
ElseIf txtTestoEmail3.Text = "" Then
MsgBox "Attenzione! Non hai impostato un valore nella casella Testo e-mail!"
txtTestoEmail3.SetFocus
Exit Sub
End If
blnAggiungi = False
h = 1
Do Until blnAggiungi = True Or h = Range("A1").CurrentRegion.Rows.Count
If Range("A" & h) = txtCodiceRegola3.Text Then
MsgBox ("Attenzione! esiste già un codice con questa Regola e-mail")
txtCodiceRegola3.SetFocus
blnAggiungi = True
Exit Sub
ElseIf Range("A" & h) = "" Then
blnAggiungi = True
End If
h = h + 1
Loop
Range("A" & h + 1) = txtCodiceRegola3.Text
Range("C" & h + 1) = txtTestoEmail3.Text
MsgBox "La regola e-mail " & txtCodiceRegola3.Text & " è stato inserita"
End Sub
Private Sub cmdCancellaRegola_Click()
blnCancella = False
I = 1
Do Until blnCancella = True Or I = Range("A1").CurrentRegion.Rows.Count
If Range("A" & I) = txtCodiceRegola.Text Then
intRisposta = MsgBox("Sei sicuro di voler cancellare l'articolo con CodiceRegola " & txtCodiceRegola.Text & "?", vbYesNo + vbCritical, "Attenzione!")
If intRisposta = vbYes Then
Range("a" & I).Select
Selection.EntireRow.Delete
MsgBox "L'articolo con CodiceRegola " & txtCodiceRegola.Text & " è stato cancellato"
txtCodiceRegola.Text = ""
txtFolder.Text = ""
txtTestoEmail.Text = ""
txtCodiceRegola.SetFocus
End If
blnCancella = True
End If
I = I + 1
Loop
If blnCancella = False Then
NonTrovato (txtCodiceRegola.Text)
End If
End Sub
Private Sub cmdChiudi_Click()
Unload frmGestioneTestoEmail
End Sub
Private Sub cmdChiudi2_Click()
cmdChiudi_Click
End Sub
Private Sub cmdChiudi3_Click()
cmdChiudi_Click
End Sub
Private Sub cmdMostraRegola_Click()
blnTrovato = False
y = 1
Do Until blnTrovato = True Or y = Range("A1").CurrentRegion.Rows.Count
If Range("A" & y) = txtCodiceRegola.Text Then
txtFolder.Text = Range("B" & y)
txtTestoEmail.Text = Range("C" & y)
blnTrovato = True
End If
y = y + 1
Loop
If blnTrovato = False Then
NonTrovato (txtCodiceRegola.Text)
End If
End Sub
Private Sub txtCodiceRegola_Change()
'le due pagine mostrano gli stessi dati
txtCodiceRegola2.Text = txtCodiceRegola.Text
End Sub
Private Sub txtFolder_Change()
'le due pagine mostrano gli stessi dati
txtFolder2.Text = txtFolder.Text
End Sub
Private Sub txtTestoEmail_Change()
'le due pagine mostrano gli stessi dati
txtTestoEmail2.Text = txtTestoEmail.Text
End Sub
Private Sub NonTrovato(CodiceRegola As String)
MsgBox "La regola e-mail " & CodiceRegola & " non è in elenco"
txtCodiceRegola.Text = ""
txtCodiceRegola.SetFocus
End Sub
'Grazie di tutto Anthony, ho imparato tantissimo
'End sub ;o)
Torna a Applicazioni Office Windows
Problema con barra delle applicazioni Autore: Gilindone |
Forum: Sistemi Operativi Windows Risposte: 4 |
Windows Foto: eliminare delle foto nella scheda Raccolta Autore: franco11 |
Forum: Software Windows Risposte: 12 |
Visitano il forum: Nessuno e 33 ospiti