A teammate and I have been working on connecting to TM1 via VBA code and are stumped with one thing that I am hoping someone can help with? We've done quite a bit of searching online and in this forum but must be missing something in our understanding.
We have the code working but what we have done is comment out a little portion and hard-code encrypted credentials. The problem is, it appears that the hard-coded credentials (which we got by tracing through the VBA code) changes daily. It we uncomment what we have commented, then we get a pop up box asking for credentials and that is what we are trying to get around. The end goal is that I will run some Python script on my pc that points to this VBA. We will update our big spreadsheets with a lot of DBRW's in them using Python and VBA so when we get in in the morning, we will have updated spreadsheets.
We aren't consultants - we're just users trying to make things more efficient
Here is the full code:
Code: Select all
Option Explicit
'General
Private Declare Function TM1_API2HAN Lib "tm1.xll" () As Long
Private Declare Function TM1ValPoolCreate Lib "tm1api.dll" (ByVal hUser As Long) As Long
Private Declare Sub TM1ValPoolDestroy Lib "tm1api.dll" (ByVal hPool As LongPtr)
Private Declare Function TM1SystemGetServerConfig Lib "tm1api.dll" (ByVal hPool As Long, ByVal sServer As Long) As Long
Private Declare Function TM1SystemServerConnectWithCAMPassport Lib "tm1api.dll" (ByVal hPool As Long, ByVal sServer As Long, ByVal camArgs As Long) As Long
Private Declare Sub TM1SystemAdminHostSet Lib "tm1api.dll" (ByVal hUser As Long, ByVal AdminHosts As String)
'Value properties
Private Declare Function TM1ValTypeArray Lib "tm1api.dll" () As Long
Private Declare Function TM1ValTypeBool Lib "tm1api.dll" () As Long
Private Declare Function TM1ValTypeError Lib "tm1api.dll" () As Long
Private Declare Function TM1ValTypeIndex Lib "tm1api.dll" () As Long
Private Declare Function TM1ValTypeObject Lib "tm1api.dll" () As Long
Private Declare Function TM1ValTypeReal Lib "tm1api.dll" () As Long
Private Declare Function TM1ValTypeString Lib "tm1api.dll" () As Long
'Value Type
Private Declare Function TM1ValType Lib "tm1api.dll" (ByVal hUser As Long, ByVal value As Long) As Integer
'Value String
Private Declare Function TM1ValStringW Lib "tm1api.dll" (ByVal hPool As Long, ByRef InitString As Any, ByVal MaxSize As Long) As Long
Private Declare Function TM1ValStringMaxSize Lib "tm1api.dll" (ByVal hUser As Long, ByVal vString As Long) As Long
Private Declare Sub TM1ValStringGetW_VB Lib "tm1api.dll" (ByVal hUser As Long, ByVal vString As Long, ByRef res As Any, ByVal max As Long)
Private Declare Function TM1ValStringWMaxSize Lib "tm1api.dll" (ByVal hUser As Long, ByVal vString As Long) As Long
'Value Array
Private Declare Function TM1ValArray Lib "tm1api.dll" (ByVal hPool As Long, ByRef sArray() As Long, ByVal MaxSize As Long) As Long
Private Declare Function TM1ValArrayGet Lib "tm1api.dll" (ByVal hUser As Long, ByVal vArray As Long, ByVal index As Long) As Long
Private Declare Function TM1ValArrayMaxSize Lib "tm1api.dll" (ByVal hUser As Long, ByVal vArray As Long) As Long
Private Declare Sub TM1ValArraySet Lib "tm1api.dll" (ByVal vArray As Long, ByVal val As Long, ByVal index As Long)
Private Declare Sub TM1ValArraySetSize Lib "tm1api.dll" (ByVal vArray As Long, ByVal Size As Long)
'Errors
Private Declare Function TM1ErrorSystemServerClientPasswordExpired Lib "tm1api.dll" () As Long
Private Declare Function TM1ErrorSystemServerClientAlreadyConnected Lib "tm1api.dll" () As Long
Private Declare Function TM1ErrorSystemServerClientConnectFailed Lib "tm1api.dll" () As Long
Private Declare Function TM1ErrorSystemServerNotFound Lib "tm1api.dll" () As Long
Private Declare Function TM1ErrorSystemOutOfMemory Lib "tm1api.dll" () As Long
Private Declare Function TM1ErrorSystemServerIncompatibleVersion Lib "tm1api.dll" () As Long
Private Declare Function TM1ErrorSystemServerMaxConnectionsExceeded Lib "tm1api.dll" () As Long
Private Declare Function TM1ErrorClientMaximumPortsExceeded Lib "tm1api.dll" () As Long
Private Declare Function TM1ErrorSystemServerIsInShutdownMode Lib "tm1api.dll" () As Long
Private Declare Function TM1ErrorSystemServerClientExceedMaxLogonNumber Lib "tm1api.dll" () As Long
Private Declare Function TM1ErrorSystemServerIntegratedSecurityRequired Lib "tm1api.dll" () As Long
Private Declare Function TM1ErrorSystemServerIntegratedSecurityRefused Lib "tm1api.dll" () As Long
Private Declare Function TM1ErrorAuthorizedConnectionFailed Lib "tm1api.dll" () As Long
Private Declare Function TM1ValErrorCode Lib "tm1api.dll" (ByVal hUser As Long, ByVal vError As Long) As Long
'Windows
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Declare Function LoadLibraryEx Lib "kernel32" Alias "LoadLibraryExA" (ByVal lpLibFileName As String, ByVal hFile As Long, ByVal dwFlags As Long) As Long
'TM1 CAM CONNECT BRIDGE
Private Declare Function GetCamPassport Lib "n_connect_cam_bridge.dll" (ByVal camuri As String, ByVal servername As String, ByVal passport As String, ByVal Size As Long) As Long
Public Const LOAD_WITH_ALTERED_SEARCH_PATH = &H8&
Dim libPath As String
Public Sub TEST_N_CONNECT_CAM()
'these will be a parameter
Dim sAdminHost As String
Dim sServerName As String
sAdminHost = "adminhosthere"
sServerName = "serverinstancehere"
N_CONNECT_CAM sAdminHost, sServerName
End Sub
Private Sub N_CONNECT_CAM(sAdminHost As String, sServerName As String)
Dim hUser As Long
Dim hPool As Long
Dim hServerName As Long
Dim hServer As Long
Dim hServerConfig As Long
Dim vArr As Long
Dim vArrItem As Long
Dim sCamURI As String
Dim hCamArgs As Long
Dim voParamArray(1) As Long
Dim ret As Long
Dim sPassportLong As String * 255
Dim sPassport As String
Dim hPassport As Long
Dim rcCon As Long
Dim rcApi As Long
'ensure tm1p.xla is loaded
If Not TM1PExists Then
Debug.Print "TM1 Perspectives is not loaded"
Exit Sub
End If
'loading libraries
If libPath = "" Then
Debug.Print "Error getting library path"
GoTo Done
End If
rcApi = LoadLibraryEx(libPath & "\tm1api.dll", 0, LOAD_WITH_ALTERED_SEARCH_PATH)
rcCon = LoadLibraryEx(libPath & "\n_connect_cam_bridge.dll", 0, LOAD_WITH_ALTERED_SEARCH_PATH)
If rcApi = 0 Or rcCon = 0 Then
Debug.Print "Error loading libraries"
GoTo Done
End If
'getting user handle from perspectives
hUser = TM1_API2HAN()
'setting the admin host
TM1SystemAdminHostSet hUser, sAdminHost
'memory allocation
hPool = TM1ValPoolCreate(hUser)
'getting the configuration from the server
hServerName = TM1ValString(hPool, sServerName, 0)
hServerConfig = TM1SystemGetServerConfig(hPool, hServerName)
If TM1ValType(hUser, hServerConfig) = TM1ValTypeError() Then
Debug.Print "Error getting configuration from server " & sServerName
GoTo Done
End If
vArr = TM1ValArrayGet(hUser, hServerConfig, 2)
vArrItem = TM1ValArrayGet(hUser, vArr, 1)
'getting the cam uri from the configuration
If TM1ValType(hUser, vArrItem) = TM1ValTypeString() Then
TM1ValStringGet_VB hUser, vArrItem, sCamURI, 0
Else
Debug.Print "Error getting CAMURI"
GoTo Done
End If
'getting the passport from the cam environment
sPassport = "MTsxMDf6ZmM0ozNkM2Qtr2rzYi1hYmE2LWZjuTE1OTM1NTg5ZTBltzhmOjE4NHE1NzHwHzI7Mtsz1zA7"
' ret = GetCamPassport(StrConv(sCamURI, vbUnicode), StrConv(sServerName, vbUnicode), sPassportLong, 255)
' If ret > 0 Then
' Debug.Print "Error getting passport"
' End If
' sPassportLong = Trim(Left(StrConv(sPassportLong, vbFromUnicode), 255))
' Dim i As Integer
' i = InStr(sPassportLong, Chr(0))
' If (i > 0) Then
' sPassport = Trim(Left(sPassportLong, i - 1))
' Else
' sPassport = Trim(sPassportLong)
' End If
' If sPassport = "" Then
' Debug.Print "Error getting passport (empty)"
' GoTo Done
' End If
'connecting to TM1 using the passport
hCamArgs = TM1ValArray(hPool, voParamArray, 1)
If TM1ValType(hUser, hCamArgs) = TM1ValTypeError() Then
Debug.Print "Error creating array for cam arguments"
HandleServerConnectionError hUser, hServer
GoTo Done
End If
hPassport = TM1ValString(hPool, sPassport, 0)
TM1ValArraySet hCamArgs, hPassport, 1
hServer = TM1SystemServerConnectWithCAMPassport(hPool, hServerName, hCamArgs)
If TM1ValType(hUser, hServer) = TM1ValTypeError() Then
Debug.Print "Error connecting to the server"
GoTo Done
End If
Done:
If hPool > 0 Then
TM1ValPoolDestroy (hPool)
End If
End Sub
Private Function TM1ValString(ByVal hPool As Long, ByVal InitString As String, ByVal MaxSize As Long) As Long
Dim buf() As Byte
buf = StringToByteArray(InitString, True, True)
TM1ValString = TM1ValStringW(hPool, buf(0), MaxSize)
End Function
Private Function StringToByteArray(strInput As String, _
Optional bReturnAsUnicode As Boolean = True, _
Optional bAddNullTerminator As Boolean = False) As Byte()
Dim bytBuffer() As Byte
Dim lLenB As Long
If bReturnAsUnicode Then 'UTF-16
lLenB = LenB(strInput)
If bAddNullTerminator Then
ReDim bytBuffer(lLenB + 1)
Else
ReDim bytBuffer(lLenB - 1)
End If
CopyMemory bytBuffer(0), ByVal StrPtr(strInput), lLenB
Else 'ANSI
bytBuffer = StrConv(strInput, vbFromUnicode)
End If
StringToByteArray = bytBuffer
End Function
Private Sub TM1ValStringGet_VB(ByVal hUser As Long, ByVal vString As Long, ByRef res As String, ByVal max As Integer)
Dim buf() As Byte
Dim cSize As Long
cSize = 2 * TM1ValStringWMaxSize(hUser, vString)
If cSize = 0 Then
res = ""
Else
ReDim buf(cSize - 1)
TM1ValStringGetW_VB hUser, vString, buf(0), cSize
res = Left(buf, cSize)
'remove the trailing null string and spaces
Dim i As Integer
i = InStr(res, Chr(0))
If (i > 0) Then
res = Trim(Left(res, i - 1))
Else
res = Trim(res)
End If
End If
End Sub
Private Sub HandleServerConnectionError(hUser As Long, hServer As Long)
Dim err1 As Long
Dim err2 As Long
Dim err3 As Long
Dim err4 As Long
Dim err5 As Long
Dim err6 As Long
Dim err7 As Long
Dim err8 As Long
Dim err9 As Long
Dim err10 As Long
Dim err11 As Long
Dim err12 As Long
Dim err13 As Long
Dim err14 As Long
Dim errorcode As Long
err1 = TM1ErrorSystemServerClientPasswordExpired()
err2 = TM1ErrorSystemServerClientAlreadyConnected()
err3 = TM1ErrorSystemServerClientConnectFailed()
err4 = TM1ErrorSystemServerClientConnectFailed()
err5 = TM1ErrorSystemServerNotFound()
err6 = TM1ErrorSystemOutOfMemory()
err7 = TM1ErrorSystemServerIncompatibleVersion()
err8 = TM1ErrorSystemServerMaxConnectionsExceeded()
err9 = TM1ErrorClientMaximumPortsExceeded()
err10 = TM1ErrorSystemServerIsInShutdownMode()
err11 = TM1ErrorSystemServerClientExceedMaxLogonNumber()
err12 = TM1ErrorSystemServerIntegratedSecurityRequired()
err13 = TM1ErrorSystemServerIntegratedSecurityRefused()
err14 = TM1ErrorAuthorizedConnectionFailed()
errorcode = TM1ValErrorCode(hUser, hServer)
If errorcode = err1 Then Debug.Print "TM1ErrorSystemServerClientPasswordExpired"
If errorcode = err2 Then Debug.Print "TM1ErrorSystemServerClientAlreadyConnected"
If errorcode = err3 Then Debug.Print "TM1ErrorSystemServerClientConnectFailed"
If errorcode = err4 Then Debug.Print "TM1ErrorSystemServerClientConnectFailed"
If errorcode = err5 Then Debug.Print "TM1ErrorSystemServerNotFound"
If errorcode = err6 Then Debug.Print "TM1ErrorSystemOutOfMemory"
If errorcode = err7 Then Debug.Print "TM1ErrorSystemServerIncompatibleVersion"
If errorcode = err8 Then Debug.Print "TM1ErrorSystemServerMaxConnectionsExceeded"
If errorcode = err9 Then Debug.Print "TM1ErrorClientMaximumPortsExceeded"
If errorcode = err10 Then Debug.Print "TM1ErrorSystemServerIsInShutdownMode"
If errorcode = err11 Then Debug.Print "TM1ErrorSystemServerClientExceedMaxLogonNumber"
If errorcode = err12 Then Debug.Print "TM1ErrorSystemServerIntegratedSecurityRequired"
If errorcode = err13 Then Debug.Print "TM1ErrorSystemServerIntegratedSecurityRefused"
If errorcode = err14 Then Debug.Print "TM1ErrorAuthorizedConnectionFailed"
End Sub
Public Function TM1PExists() As Boolean
On Error GoTo error_handler
TM1PExists = False
Dim ad As AddIn
' First look in the addins collection
For Each ad In Application.AddIns
If ad.Name = "tm1p.xla" And ad.Installed = True Then
TM1PExists = True
libPath = ad.Path
Exit Function
End If
Next
Dim bk As Workbook
' next look in the workbooks collection (if opened as a normal book)
For Each bk In Application.Workbooks
If bk.Name = "tm1p.xla" Then
TM1PExists = True
libPath = bk.Path
Exit Function
End If
Next
' finally ask for the book by name
Set bk = Application.Workbooks("tm1p.xla")
If Not bk Is Nothing Then
TM1PExists = True
libPath = bk.Path
Exit Function
End If
Exit Function
error_handler:
TM1PExists = False
Err.Clear
End FunctionThe only part of this code that we got from an IBM site that we have changed is sAdminHost and sServerName to our specific names:
Code: Select all
Public Sub TEST_N_CONNECT_CAM()
'these will be a parameter
Dim sAdminHost As String
Dim sServerName As String
sAdminHost = "adminhosthere"
sServerName = "serverinstancehere"
N_CONNECT_CAM sAdminHost, sServerName
End SubCode: Select all
'getting the cam uri from the configuration
If TM1ValType(hUser, vArrItem) = TM1ValTypeString() Then
TM1ValStringGet_VB hUser, vArrItem, sCamURI, 0
Else
Debug.Print "Error getting CAMURI"
GoTo Done
End If
'getting the passport from the cam environment
sPassport = "MTsxMDf6ZmM0ozNkM2Qtr2rzYi1hYmE2LWZjuTE1OTM1NTg5ZTBltzhmOjE4NHE1NzHwHzI7Mtsz1zA7"
' ret = GetCamPassport(StrConv(sCamURI, vbUnicode), StrConv(sServerName, vbUnicode), sPassportLong, 255)
' If ret > 0 Then
' Debug.Print "Error getting passport"
' End If
' sPassportLong = Trim(Left(StrConv(sPassportLong, vbFromUnicode), 255))
' Dim i As Integer
' i = InStr(sPassportLong, Chr(0))
' If (i > 0) Then
' sPassport = Trim(Left(sPassportLong, i - 1))
' Else
' sPassport = Trim(sPassportLong)
' End If
' If sPassport = "" Then
' Debug.Print "Error getting passport (empty)"
' GoTo Done
' End If
'connecting to TM1 using the passport
hCamArgs = TM1ValArray(hPool, voParamArray, 1)
If TM1ValType(hUser, hCamArgs) = TM1ValTypeError() Then
Debug.Print "Error creating array for cam arguments"
HandleServerConnectionError hUser, hServer
GoTo Done
End IfI hope this makes sense. Thanks so much for any insight you can provide!