Handle Ribbon Files with msxlm2
-
Sunday, June 12, 2011 11:33 AM
I wont to custumize the Ribbon with VBA. I know it's not directly posible, but...
You gan handle de XML-files with the object msxlm (domdocument).
Is there already some code read en write nodes? I look the internet, but i can't figger it out...:(
Answers
-
Monday, June 13, 2011 2:03 PM
I've created the code below. It works! Maybe somebody knows how to do it with msxlm?'--------------------------------------------------------------------------------------- ' Module : ThisOutlookSession ' Date : 13-6-2011 @ 15:36 ' Purpose : Dynamic Add button to QAT (Quick Access Toolbar) in Outlook ' strCustomNode : change ProjectName, ProcedureName, LabelName ' strFileName : change UserName '--------------------------------------------------------------------------------------- Option Explicit Const strCustomNodeRoot = "<mso:customUI xmlns:x1=""http://schemas.microsoft.com/office/2006/01/customui/macro"" xmlns:mso=""http://schemas.microsoft.com/office/2006/01/customui"">" Const strCustomNode = "<mso:button idQ=""x1:ProjectName.ProcedureName_1"" visible=""true"" label=""LabelName"" onAction=""ProjectName.ProcedureName"" imageMso=""HappyFace""/>" Const strFileName = "C:\Documents and Settings\UserName\Local Settings\Application Data\Microsoft\Office\olkmailitem.qat" Dim strFileContent As String Dim oXMLDoc As New DOMDocument Private Sub Application_Startup() If Dir(strFileName) = "" Then createXML Exit Sub End If Open strFileName For Input As #1 strFileContent = input$(LOF(1), 1) Close #1 If NodeExist(strFileContent, strCustomNode) = False Then insertNode End If End Sub Private Sub insertNode() Dim strNode As String Dim strNodes Dim r As Long Dim strXML As String strNodes = Split(strFileContent, "<") Do r = r + 1 If r = 1 Then strNode = strCustomNodeRoot Else strNode = "<" & Replace(strNodes(r), vbCrLf, "") End If Select Case strNode
Case Is = "<mso:qat/>"
' No QAT!
strXML = strXML & _
"<mso:qat>" & _
"<mso:sharedControls>" & _
strCustomNode & _
"</mso:sharedControls>" & _
"</mso:qat>"
Case Is = "</mso:sharedControls>"
' QAT edit
strXML = strXML & strCustomNode & strNode
Case Else
strXML = Trim(strXML & strNode)
End Select Loop Until strNode = "</mso:customUI>" oXMLDoc.LoadXML Trim(strXML) oXMLDoc.Save (strFileName) End Sub Private Sub createXML() Dim strCustomUI As String strCustomUI = _ strCustomNodeRoot & _ "<mso:ribbon>" & _ "<mso:qat>" & _ "<mso:sharedControls>" & _ strCustomNode & _ "</mso:sharedControls>" & _ "</mso:qat>" & _ "</mso:ribbon>" & _ "</mso:customUI>" oXMLDoc.LoadXML strCustomUI oXMLDoc.Save (strFileName) End Sub Private Function NodeExist(str1 As String, str2 As String) As Boolean If InStr(1, str1, str2) Then NodeExist = True End Function
