08/06/2012 13:45

Dicas para Conexão - CMS x VBA

Segue um modelo de conexão em VBA que interage diretamente com o CMS através da utilização de api.
Desta forma, a automatização na extração de dados para relatórios dinâmicos fica de certa forma mais viável e prático.

Código comentado:

"

Public Sub CMSConn()
Dim cvsApp As Object
Dim cvsConn As Object
Dim cvsSrv As Object
Dim Rep As Object
Dim Info As Object, Log As Object, b As Object
Dim Caminho As String
Dim Mydates As String


'Variavel da data
Mydates = Sheets("Plan1").Range("A1").Value
'Variavel do caminho do relatório [ex: Histórico\Grupo / Especialidade\Perfil de Atendimento (Diário)]
Caminho = Sheets("Plan2").Range("A2").Value


Set cvsApp = CreateObject("ACSUP.cvsApplication")
Set cvsConn = CreateObject("ACSCN.cvsConnection")
Set cvsSrv = CreateObject("ACSUPSRV.cvsServer")
Set Rep = CreateObject("ACSREP.cvsReport")

'servidor
serverAddress = "informe servidor utilizado
'informações de login
UserName = "usuário"
passW = "senha"
'skill do relatório (pode ser alterado para variável)
skillName = "xxxxxx"
If cvsApp.CreateServer(UserName, "", "", serverAddress, False, "ENU", cvsSrv, cvsConn) Then
If cvsConn.login(UserName, passW, serverAddress, "ENU") Then
On Error Resume Next
cvsSrv.Reports.ACD = 1
Set Info = cvsSrv.Reports.Reports(Caminho)
If Info Is Nothing Then
If cvsSrv.Interactive Then
MsgBox "O relatório " & "Caminho" & " não foi encontrado on ACD 1", vbCritical Or vbOKOnly, "CentreVu Supervisor"
Else
Set Log = CreateObject("ACSERR.cvslog")
Log.AutoLogWrite "O relatório " & "Caminho" & " não foi encontrado on ACD 1"
Set Log = Nothing
End If
Else
b = cvsSrv.Reports.CreateReport(Info, Rep)
If b Then
Debug.Print Rep.SetProperty("Grupo/Especialidade", skillName)
Debug.Print Rep.SetProperty("Datas", Mydates)
Debug.Print Rep.SetProperty("Horário", "00:00-23:59")
b = Rep.ExportData("", 9, 0, False, True, True)
Set wk = ThisWorkbook
wk.Sheets(1).Cells.ClearContents
wk.Sheets(1).Cells(1, 1).PasteSpecial

'b = Rep.ExportData(fileP, 9, 0, False, True, True)


Rep.Quit
If Not cvsSrv.Interactive Then cvsSrv.ActiveTasks.Remove Rep.TaskID
Set Rep = Nothing
End If
End If

Set Info = Nothing
End If

End If

cvsConn.logout
cvsConn.Disconnect
cvsSrv.Connected = False
Set Log = Nothing
Set Rep = Nothing
Set cvsSrv = Nothing
Set cvsConn = Nothing
Set cvsApp = Nothing


End Sub

"

—————

Voltar


Contato

XL CONSULTORIA