Buongiorno a tutti. Premetto che non sono per niente esperto in VBA. Stavo cercando di modificare una macro che permetta in Outlook la gestione delle mail in una shared mailbox condivisa (in un help desk dove lavoro). Nello specifico, la funzione della macro e' quella di aprire una finestra in cui si possono inserire specifiche riguardo alla mail: descrizione, stato, categoria,numero ticket etc.
Per ora funziona tutto, a parte una funzione (la piu utile ) ovvero , ogni volta che una persona esegue questa macro sulla mail, su outlook in seguito deve poter apparire il nome utente della persona che ha gestito la mail (tra i campi oggetto, data etc)
Questa macro l'avevo scopiazzata da un altro progetto in cui lavoravo (chi l'aveva creata purtroppo non lavora piu' qua da anni), e la unzione sopracitata andava a riconoscere la persona che stava lavorando la mail andando a fare un check nel winlogon dalle chiavi di registro. Qua non funziona. Oltretutto noi sui pc usiamo utenze di rete in dominio per accedere a WIN, non utenze desktop locali
Info: O.S: Win7 32 BIT. Office 2010.
Qua sotto vi copio la macro, nella speranza che qualcuno mi possa aiutare (la parte relativa al riconoscimento dell'utenza e' verso la fine)
Option Explicit
Private OperatoreValues(3) As String
Private myMail As MailItem
Private Sub cmdCancel_Click()
' Err.Clear
' On Error Resume Next
' myMail.Save
' On Error GoTo 0
Set myMail = Nothing
Unload Me
End Sub
Private Sub cmdOk_Click()
If (cmbAction.Value = "") And (Left$(cmbStato.Value, 1) <> "0") And (Left$(cmbStato.Value, 1) <> "1") Then
MsgBox "Please select an Action", vbCritical + vbOKOnly, "Necessary Value"
cmbAction.SetFocus
Exit Sub
End If
Dim oldOp As String
Dim newOp As String
Dim stAva As String
Dim msgSecurity As String
msgSecurity = "Soltanto il vecchio operatore o uno dei responsabili " & vbCrLf & "può modificare lo stato " & vbCrLf & "di un'eMail Completata"
txtMailEnd.Text = Now
stAva = ""
newOp = cmbOperatori.Text
oldOp = myMail.UserProperties.Find("Operatore").Value
If Not IsNull(myMail.UserProperties.Find("StatoAvanzamento").Value) Then
stAva = CStr(myMail.UserProperties.Find("StatoAvanzamento").Value)
End If
If (newOp <> "stratim") And (newOp <> "villam") And (newOp <> "verdema") _
And (newOp <> oldOp) And (False Or (stAva = "2-Completata")) Then
' myMail.UserProperties.Find("Operatore").Value = cmbOperatori.Value
MsgBox msgSecurity, vbCritical + vbOKOnly, "Security Error"
Else
myMail.UserProperties.Find("Operatore").Value = cmbOperatori.Text
myMail.UserProperties.Find("StatoAvanzamento").Value = cmbStato.Value
End If
' myMail.UserProperties.Find("Urgenza").Value = cmbUrgenza.Value
myMail.UserProperties.Find("CategoryFR").Value = cmbCategory.Value
myMail.UserProperties.Find("TT").Value = txtTT.Text
myMail.UserProperties.Find("Annotazioni").Value = txtAnnotazioni.Text
myMail.UserProperties.Find("History").Value = txtHistory.Text & _
cmbOperatori.Text & "-" & "-" & cmbStato.Value & "-" & _
cmbCategory.Value & "-" & txtTT.Text & "-" & txtAnnotazioni.Text _
& "-" & Now() & vbCrLf
myMail.UserProperties.Find("MailPriority").Value = txtMailPriority.Text
myMail.UserProperties.Find("MailValue").Value = txtMailValue.Text
myMail.UserProperties.Find("MailStart").Value = txtMailStart.Text
myMail.UserProperties.Find("MailEnd").Value = txtMailEnd.Text
myMail.UserProperties.Find("TTBehaviour").Value = cmbAction.Value
myMail.UserProperties.Find("IdThread").Value = txtIdThread.Text
Err.Clear
On Error Resume Next
myMail.Save
' Set myMail = Nothing
' myMail.Close olSave
' myMail.Display
If Err Then
MsgBox "Impossibile impostare i valori desiderati." & vbCrLf & _
"Probabile accesso contemporaneo di un altro operatore." & _
vbCrLf & "Verificare e riprovare" & vbCrLf & "(Messaggio supplementare)" _
& vbCrLf & Err.Description, vbInformation + vbOKOnly, "Imput error"
End If
On Error GoTo 0
Set myMail = Nothing
Unload Me
End Sub
Private Sub cmdRefreshThread_Click()
myMail.UserProperties.Find("IdThread").Value = ""
txtIdThread.Text = SetIdThread(myMail)
End Sub
Private Sub Label11_Click()
End Sub
Private Sub Label4_Click()
End Sub
Private Sub Label6_Click()
End Sub
Private Sub UserForm_Activate()
Err.Clear
On Error Resume Next
Set myMail = Outlook.ActiveInspector.CurrentItem
If Err Then
MsgBox "L'email va prima aperta con doppio click", vbOKOnly + vbInformation, _
"Aprire l'email, prima"
On Error GoTo 0
Unload Me
Exit Sub
End If
On Error GoTo 0
cmbOperatori.Clear
cmbOperatori.AddItem "<Operatore non censito>"
cmbOperatori.AddItem "arcuril"
cmbOperatori.AddItem "cecchinim"
cmbOperatori.AddItem "chiusinom"
cmbOperatori.AddItem "grassos"
cmbOperatori.AddItem "luccim"
cmbOperatori.AddItem "mingottid"
cmbOperatori.AddItem "rotondos"
cmbOperatori.AddItem "fortunatof"
cmbOperatori.AddItem "siringoc"
cmbOperatori.AddItem "stratim"
cmbOperatori.AddItem "tuminog"
cmbOperatori.AddItem "teramo_e"
cmbOperatori.AddItem "turchettie"
cmbOperatori.AddItem "verdema"
cmbOperatori.AddItem "villam"
cmbOperatori.AddItem "meler"
cmbOperatori.AddItem "fenzia"
cmbOperatori.AddItem "guidarellig"
cmbOperatori.AddItem "sayaa"
cmbOperatori.AddItem "crisafullig"
cmbOperatori.AddItem "pezzellam"
cmbOperatori.AddItem "messinac"
cmbOperatori.AddItem "dardor"
cmbOperatori.AddItem "turrisis"
cmbOperatori.AddItem "vashisthas"
cmbOperatori.AddItem "vergoriv"
cmbOperatori.AddItem "catacchiog"
cmbOperatori.AddItem "krajb"
cmbOperatori.AddItem "cavanid"
cmbOperatori.AddItem "spahob"
cmbOperatori.AddItem "galbiatil"
cmbOperatori.AddItem "furrud"
cmbOperatori.AddItem "corciuloc"
cmbOperatori.AddItem "majkowskam"
cmbOperatori.AddItem "badescuc"
cmbOperatori.AddItem "nozzolinor"
cmbOperatori.AddItem "kirkiewicza"
cmbOperatori.AddItem "alabisov"
cmbStato.Clear
cmbStato.AddItem "0-Free"
cmbStato.AddItem "1-In charge"
' cmbStato.AddItem "2-Waiting for reply"
cmbStato.AddItem "2-Completed"
cmbStato.AddItem "3-Info"
cmbStato.AddItem "4-No action required"
' cmbUrgenza.Clear
' cmbUrgenza.AddItem "0-Lowest"
' cmbUrgenza.AddItem "1-Low"
' cmbUrgenza.AddItem "2-Medium"
' cmbUrgenza.AddItem "3-High"
' cmbUrgenza.AddItem "4-Hightest"
' cmbUrgenza.AddItem "5-Urgent"
cmbAction.Clear
cmbAction.AddItem "0-The eMail generate new TT"
cmbAction.AddItem "1-The eMail doesen't generate new TT, becasue there is already one "
cmbAction.AddItem "2-The eMail doesen't generate new TT"
cmbCategory.Clear
cmbCategory.AddItem "HCL"
cmbCategory.AddItem "HONDA"
cmbCategory.AddItem "Info"
cmbCategory.AddItem "Internal"
cmbCategory.AddItem "Spam"
txtFrom.Text = myMail.SenderName
txtSubject.Text = myMail.Subject
'error on electronic signature
Err.Clear
On Error Resume Next
txtBody.Text = myMail.Body
If Err Then
txtBody.Text = "-------------------------- ERROR on mail body ------------------------" & vbCrLf & Err.Description
End If
myMail.UserProperties.Add "Operatore", olText
' cmbOperatori.Value = myMail.UserProperties.Find("Operatore").Value
' txtOperatore.Text = myMail.UserProperties.Find("Operatore").Value
Err.Clear
On Error Resume Next
cmbOperatori.Text = GetUsername
If Err Then
cmbOperatori.Text = "<Operatore non censito>"
End If
On Error GoTo 0
myMail.UserProperties.Add "MailPriority", olText
txtMailPriority.Text = myMail.UserProperties.Find("MailPriority").Value
myMail.UserProperties.Add "MailValue", olText
txtMailValue.Text = myMail.UserProperties.Find("MailValue").Value
myMail.UserProperties.Add "MailStart", olText
txtMailStart.Text = myMail.UserProperties.Find("MailStart").Value
myMail.UserProperties.Add "MailEnd", olText
txtMailEnd.Text = myMail.UserProperties.Find("MailEnd").Value
myMail.UserProperties.Add "StatoAvanzamento", olText
cmbStato.Value = myMail.UserProperties.Find("StatoAvanzamento").Value
' myMail.UserProperties.Add "Urgenza", olText
' cmbUrgenza.Value = myMail.UserProperties.Find("Urgenza").Value
myMail.UserProperties.Add "CategoryFR", olText
cmbCategory.Value = myMail.UserProperties.Find("CategoryFR").Value
myMail.UserProperties.Add "TT", olText
txtTT.Text = myMail.UserProperties.Find("TT").Value
myMail.UserProperties.Add "Annotazioni", olText
txtAnnotazioni.Text = myMail.UserProperties.Find("Annotazioni").Value
myMail.UserProperties.Add "History", olText
txtHistory.Text = myMail.UserProperties.Find("History").Value
myMail.UserProperties.Add "TTBehaviour", olText
cmbAction.Value = myMail.UserProperties.Find("TTBehaviour").Value
myMail.UserProperties.Add "IdThread", olText
txtIdThread.Text = myMail.UserProperties.Find("IdThread").Value
If txtIdThread.Text = "" Then
txtIdThread.Text = SetIdThread(myMail)
End If
If cmbStato.ListIndex = -1 Then
cmbStato.Text = "1-In charge"
End If
If txtMailPriority.Text = "" Then
txtMailPriority.Text = "50"
End If
If txtMailValue.Text = "" Then
txtMailValue.Text = "1"
End If
If txtMailStart.Text = "" Then
txtMailStart.Text = Now
End If
If (cmbOperatori.Text = "villam") Or (cmbOperatori.Text = "stratim") Or (cmbOperatori.Text = "verdema") Then
cmbOperatori.Locked = False
txtMailPriority.Locked = False
txtMailValue.Locked = False
cmbOperatori.SetFocus
Else
cmbStato.SetFocus
End If
End Sub
Private Function GetUsername() As String
Const regKeyName As String = "Software\Microsoft\Windows NT\CurrentVersion\Winlogon"
Const regNameUser As String = "AltDefaultUserName"
Const regNameDomain As String = "AltDefaultDomainName"
Dim userValue As String
Dim myReg As New Registry
Err.Clear
On Error Resume Next
myReg.GetKeyValue HKEY_LOCAL_MACHINE, regKeyName, regNameUser, userValue
On Error GoTo 0
If Err Then
userValue = "Errore"
End If
GetUsername = userValue
End Function
'Private Sub cmdOk_Click()
' Dim oldOp As String
' Dim newOp As String
'
' newOp = txtOperatore.Text
' oldOp = ""
' If Not IsNull(myMail.UserProperties.Find("StatoAvanzamento").Value) Then
' oldOp = CStr(myMail.UserProperties.Find("StatoAvanzamento").Value)
' End If
'
' If (((newOp = "stratim") Or (newOp = "villam") Or (newOp = "verdema")) And (oldOp = "")) _
' Or ((newOp <> "stratim") And (newOp <> "villam") And (newOp <> "verdema")) Then
' ' myMail.UserProperties.Find("Operatore").Value = cmbOperatori.Value
' myMail.UserProperties.Find("Operatore").Value = txtOperatore.Text
' End If
' myMail.UserProperties.Find("Urgenza").Value = cmbUrgenza.Value
' myMail.UserProperties.Find("StatoAvanzamento").Value = cmbStato.Value
' myMail.UserProperties.Find("CategoryFR").Value = cmbCategory.Value
' myMail.UserProperties.Find("TT").Value = txtTT.Text
' myMail.UserProperties.Find("Annotazioni").Value = txtAnnotazioni.Text
' myMail.UserProperties.Find("History").Value = txtHistory.Text & _
' txtOperatore.Text & "-" & cmbUrgenza.Value & "-" & cmbStato.Value & "-" & _
' cmbCategory.Value & "-" & txtTT.Text & "-" & txtAnnotazioni.Text _
' & "-" & Now() & vbCrLf
'
' Err.Clear
' On Error Resume Next
' myMail.Save
'' Set myMail = Nothing
'' myMail.Close olSave
'' myMail.Display
' If Err Then
' MsgBox "Impossibile impostare i valori desiderati." & vbCrLf & _
' "Probabile accesso contemporaneo di un altro operatore." & _
' vbCrLf & "Verificare e riprovare" & vbCrLf & "(Messaggio supplementare)" _
' & vbCrLf & Err.Description, vbInformation + vbOKOnly, "Errore su inserimento"
' End If
' On Error GoTo 0
' Set myMail = Nothing
' Unload Me
'End Sub