Send Excel macro message to Skype for Bussiness [closed]

1

I have a code that sends messages via lync but the system has been migrated to Skype for Bussiness . Could someone help me how to mute the code to send.

When you try to run the macro it displays the error "Compile error: Can´t find project or library" . Here is the code below:

Dim OlApp As New Outlook.Application
Dim linha
Sub Email(Nome, mail)

temp = "<HTML> <p><strong>Prezado(a): #nome</strong></p> <p>&nbsp;</p> <p>Voce " & _
" possui pendencia(s) de apontamento(s)no ESS.<br></br>" & _
"O target programado para este mês de Setembro não está 100%.<br>" & _
"Por gentileza, verificar seus apontamentos acessando <a href=" & Chr(14) & "https://www.myatos.net/irj/portal" & Chr(14) & "> www.myatos.net </a> , click em <b>Time</b> ou <b>Leave</b> observando os seguintes itens:<br><br></br>" & _
"Lançamento das suas horas (conforme target) por semana;<br>" & _
"* Apontamento Unpaid Leave para os dias de compensação de banco de horas;<br>" & _
"* Apontamento de atestados (sickness) - Se caso tenha ficado ausente por este motivo;<br>" & _
"* Apontamento de férias (vacations) na opção Leave para o mês atual ou para férias Programadas.<br>" & _
"* Esta notificação será enviada até que seus apontamentos estejam OK.<br>" & _
"* Obrigado! </br>"

temp = Replace(temp, "#nome", Nome, 1, 1, vbTextCompare)

If OlApp Is Nothing Then Err.Raise ERR_OUTLOOK_NOT_OPEN

Set EML = OlApp.CreateItem(olMailItem)
EML.HTMLBody = temp
EML.To = mail
EML.Subject = ("Apontamento Ess")
'mostrar email
EML.DISPLAY
'' EML.send

End Sub

Sub User_Status(User)
Dim myOCS As New CommunicatorAPI.Messenger
Dim OCS_User_Mail_ID As String
Dim curr_status As Integer
Dim flag As Integer
Dim stat As String
Dim msgr As CommunicatorAPI.IMessengerConversationWndAdvanced

stat = ""
OCS_User_Mail_ID = User

Application.Wait Now() + TimeValue("00:00:03")
curr_status = myOCS.GetContact(OCS_User_Mail_ID, myOCS.MyServiceId).Status
Application.Wait Now() + TimeValue("00:00:04")
If curr_status = 34 Then stat = "Away"
If curr_status = 10 Then stat = "Busy"
If curr_status = 18 Then stat = "Idle"
If curr_status = 1 Then stat = "Offline"
If curr_status = 2 Then stat = "Online"
If curr_status = 0 Then stat = "Unknown"

Application.Wait Now() + TimeValue("00:00:05")
curr_status = myOCS.GetContact(OCS_User_Mail_ID, myOCS.MyServiceId).Status
If curr_status = 34 Then stat = "Away"
If curr_status = 10 Then stat = "Busy"
If curr_status = 18 Then stat = "Idle"
If curr_status = 1 Then stat = "Offline"
If curr_status = 2 Then stat = "Online"
If curr_status = 0 Then stat = "Unknown"


If curr_status <> 1 And curr_status <> 0 Then

Set msgr = Messenger.InstantMessage(OCS_User_Mail_ID)

' manda msg lync


procura = InStr(1, User, ".", vbTextCompare)
Nome = Mid(User, 1, procura - 1)
msgr.SendText ("Olá " & Nome)
msgr.SendText (" ")
msgr.SendText ("Você possui pendência( s ) de apontamento( s ) no ESS.")
msgr.SendText ("O target programado para você no mês de " & Format(Now(), "MMMM") & " não está 100%.")
msgr.SendText ("Por gentileza, verificar seus apontamentos acessando www.myatos.net , click em Time ou Leave observando aos seguintes itens:")
msgr.SendText ("* Lançamento das suas horas (conforme target) por semana;")
msgr.SendText ("* Apontamento Unpaid Leave para os dias de compensação de banco de horas;")
msgr.SendText ("* Apontamento de atestados (sickness) - Se caso tenha ocorrido;")
msgr.SendText ("* Apontamento de férias (vacations) na opção Leave para o mês atual ou para férias Programadas.")
msgr.SendText (" ")
msgr.SendText ("* Esta notificação será enviada até que seus apontamentos estejam OK.")
msgr.SendText ("* Obrigado!")
' msgr.SendText (" ")
' msgr.SendText (" ")
' msgr.SendText (" ")
Range("I" & linha).Value = "Lync"
Range("J" & linha).Value = Now()
'msgr.Close

Else

Nome = Range("A" & linha).Value
Call Email(Nome, Range("H" & linha).Value)
Range("I" & linha).Value = "Email"
Range("J" & linha).Value = Now()

End If


End Sub

Sub Cobrar()

'
'bara de status
'

Dim lRng As Range
Dim lCel As Range
Dim lContador As Long
Dim lTotal As Long


num = WorksheetFunction.CountA(Range("I11:I1000"))


linha = 13
percentual = 1
'
'quantidade a ser acionada
'



While (Range("G" & linha).Value <> "")

If (Range("G" & linha).Value = "Sim") Then

If (Range("H" & linha).Value <> "") Then

User_Status (Range("H" & linha).Value)
Range("C9").Value = percentual / num
percentual = percentual + 1
End If
End If



linha = linha + 1
Wend
Range("C9").Value = ""


End Sub
    
asked by anonymous 10.10.2016 / 15:48

0 answers