Pages in this article
-
Worksheet Data
-
Form Controls
-
Edit with VBA
-
Add RibbonX
Editing elements in an OpenXML file using VBA
Wouldn't it be useful to be able to edit the contents of an Office
OpenXML file from within VBA? Well, now you can.
Download
I have made the file used in this article available for download:
EditOpenXML.zip
Doug Glancy, a colleague of mine, has developed
a tool to edit the RibbonX code in your file without ever leaving
Excel.
Content of the VBA project
The VBA project contains two modules and one class module:
Content of the VBA project as shown in the project explorer in the VBE
modDemo contains the code that demonstrates the use of the class
module clsEditOpenXML. modUNC contains code to work with UNC paths.
The project also uses the Microsoft XML library to ease working with
the XML, as shown in the following screenshot of the references:
References of the VBAProject
Also, a couple of other libraries are put to use: the File Scripting
Object and the Windows Shell application object, both through late
binding as shown later on.
Class module to work with OpenXML files
I have derived a class module that is able to perform the following
tasks:
- Unzip an .xlsx or .xlsm file
- Extract any XML file from the folderstructure
- Write back any XML file back into the folder structure
- Zip the file back.
Unzip an .xlsx or .xlsm file
In order to be able to work with the files contained within the
OpenXML zipped file structure, the first step that is needed is to unzip
the content of the file.
For safety reasons a backup copy of the file is made first. Then the
file is renamed by appending .zip after the name. Next, the .zip file is
unzipped to a folder.
The code below (taken from class module clsEditOpenXML) shows how
this is done:
Public Sub
UnzipFile()
'-------------------------------------------------------------------------
' Procedure : UnzipFile
' Company : JKP Application Development Services
(c)
' Author : Jan Karel Pieterse
' Created : 6-5-2009
' Purpose : Unzips all files in a zip file to a
designated folder
'-------------------------------------------------------------------------
'Courtesy www.rondebruin.nl
Dim FSO As
Object
Dim oShellApp As
Object
Set FSO =
CreateObject("scripting.filesystemobject")
'Derive the folder to unzip to from the
location of the sourcefile
UnzipFolder = FolderName
'A dedicated unzip folder will be created in
the same folder as the sourcefile,
'called ..\Unzipped Filename\
If Right(UnzipFolder, 1) <> "\"
Then
UnzipFolder = UnzipFolder & "\UnZipped " & FileName & "\"
Else
UnzipFolder = UnzipFolder & "UnZipped " & FileName & "\"
End If
On Error
Resume Next
'Remove all previous existing folders
FSO.deletefolder UnzipFolder & "*", True
Kill UnzipFolder & "*.*"
On Error
GoTo 0
'Create normal folder
If FolderExists(UnzipFolder) =
False Then
MkDir UnzipFolder
End If
Set oShellApp =
CreateObject("Shell.Application")
'Copy the files in the newly created folder
oShellApp.Namespace(UnzipFolder).CopyHere
oShellApp.Namespace(SourceFile).items
On Error
Resume Next
'Clean up temp folder
FSO.deletefolder Environ("Temp") & "\Temporary Directory*",
True
'Inside the now unzipped folder structure all
relevant files are
'located here:
XLFolder = UnzipFolder & "xl\"
Set oShellApp =
Nothing
Set FSO = Nothing
Exit Sub
End Sub
Extract any XML file from the folderstructure
This little routine extracts an xml file from the unzipped folders
and returns the XML contained in that file:
Public Function
GetXMLFromFile(sFileName As
String) As
String
'-------------------------------------------------------------------------
' Procedure : GetXMLFromFile
' Company : JKP Application Development Services
(c)
' Author : Jan Karel Pieterse
' Created : 6-5-2009
' Purpose : Gets the XML code from the
foldername\filename
'-------------------------------------------------------------------------
Dim oXMLDoc As
MSXML2.DOMDocument
If Len(XLFolder) = 0
Then
GetXMLFromFile = ""
Else
Set oXMLDoc =
New MSXML2.DOMDocument
oXMLDoc.Load XLFolder & sFileName
GetXMLFromFile = oXMLDoc.XML
Set oXMLDoc =
Nothing
End If
End Function
Write back any XML file back into the folder structure
The opposite direction is equally straightforward:
Public Sub
WriteXML2File(sXML As
String, sFileName As
String)
'-------------------------------------------------------------------------
' Procedure : WriteXML2File
' Company : JKP Application Development Services
(c)
' Author : Jan Karel Pieterse
' Created : 6-5-2009
' Purpose : Writes sXML to sFileName
'-------------------------------------------------------------------------
Dim oXMLDoc As
MSXML2.DOMDocument
Set oXMLDoc = New
MSXML2.DOMDocument
oXMLDoc.loadXML sXML
oXMLDoc.Save XLFolder & sFileName
End Sub
Zip the file back.
After we're done editing the xml contents of the unzipped OpenXML
package we need to rezip the folders again. The code below does exactly
that:
Public Sub
ZipAllFilesInFolder()
'-------------------------------------------------------------------------
' Procedure : ZipAllFilesInFolder
' Company : JKP Application Development Services
(c)
' Author : Jan Karel Pieterse
' Created : 6-5-2009
' Purpose : Zips all files in a folder
(including subfolders) whilst retaining the folder structure
'-------------------------------------------------------------------------
'Courtesy www.rondebruin.nl
Dim oShellApp As
Object
Dim sDate As
String
Dim sDefPath As
String
Dim vFileNameZip As
Variant
Dim FSO As
Object
Dim lFileCt As
Long
Set FSO =
CreateObject("scripting.filesystemobject")
'To ensure a unique filename,
'append date and time to the name of the
current file
sDate = Format(Now, " dd-mmm-yy h-mm-ss")
vFileNameZip = SourceFile & sDate & ".zip"
'Create empty Zip File
NewZip vFileNameZip
Set oShellApp =
CreateObject("Shell.Application")
'Count how many items are in the "old" folder
lFileCt = oShellApp.Namespace(FolderName & "Unzipped " &
FileName & "\").items.Count
'Copy the files to the compressed folder
oShellApp.Namespace(vFileNameZip).CopyHere
oShellApp.Namespace(FolderName & "Unzipped " & FileName & "\").items
'Keep script waiting until we have same # of
files in the new folder
On Error
Resume Next
Do Until
oShellApp.Namespace(vFileNameZip).items.Count = lFileCt
Application.Wait (Now + TimeValue("0:00:01"))
Loop
DoEvents
'Remove original file
Kill SourceFile
'Rename new zipped file to same name as
original file (with .zip appended)
Name vFileNameZip As SourceFile
On Error
Resume Next
'Now remove old folder, just in case something
went haywire
FSO.deletefolder FolderName & "Unzipped " & FileName,
True
On Error
GoTo 0
Set oShellApp =
Nothing
End Sub
Getting the xml file belonging to a specific sheet
One of the most basic operations when working with the OpenXML
package would be changing the XML of a worksheet in the file. Of course
we'd want to extract the proper XML from the package based on the
information mere mortals know: the sheet's name. The code shown below
extracts the proper rId (relationship identifier) attribute value as it
is listed within the file workbook.xml within the sheets node of that
file.
Private Function
GetSheetIdFromSheetName(sSheetName) As
String
'-------------------------------------------------------------------------
' Procedure : GetSheetIdFromSheetName
' Company : JKP Application Development Services
(c)
' Author : Jan Karel Pieterse
' Created : 6-5-2009
' Purpose : Finds out what the SheetId of
sSheetname is
' by reading Workbook.xml
'-------------------------------------------------------------------------
Dim oXMLDoc As
MSXML2.DOMDocument
Dim oXMLNode As
MSXML2.IXMLDOMNode
Dim oXMLNodeList As
MSXML2.IXMLDOMNodeList
If mvXLFolder <> "" And Sheet2Change
<> "" Then
Set oXMLDoc =
New MSXML2.DOMDocument
oXMLDoc.Load XLFolder & "workbook.xml"
Set oXMLNodeList =
oXMLDoc.SelectNodes("/workbook/sheets/sheet")
For Each
oXMLNode In oXMLNodeList
If
oXMLNode.Attributes.getNamedItem("name").nodeValue = sSheetName
Then
GetSheetIdFromSheetName =
oXMLNode.Attributes.getNamedItem("r:id").nodeValue
Exit
Function
End If
Next
End If
End Function
The next routine then finds out which xml file belongs to that Id:
Public Function
GetSheetFileNameFromId(sSheetId As
String) As
String
'-------------------------------------------------------------------------
' Procedure : GetSheetFileNameFromId
' Company : JKP Application Development Services
(c)
' Author : Jan Karel Pieterse
' Created : 6-5-2009
' Purpose : Fetches the name of the xml file
belonging to the sheet with id SheetId.
'-------------------------------------------------------------------------
Dim oXMLDoc As
MSXML2.DOMDocument
Dim oXMLNode As
MSXML2.IXMLDOMNode
Dim oXMLNodeList As
MSXML2.IXMLDOMNodeList
If mvXLFolder <> "" And Sheet2Change
<> "" Then
Set oXMLDoc =
New MSXML2.DOMDocument
oXMLDoc.Load XLFolder & "_rels\workbook.xml.rels"
Set oXMLNodeList =
oXMLDoc.SelectNodes("/Relationships/Relationship")
For Each
oXMLNode In oXMLNodeList
If
oXMLNode.Attributes.getNamedItem("Id").nodeValue = sSheetId
Then
GetSheetFileNameFromId =
oXMLNode.Attributes.getNamedItem("Target").nodeValue
Exit
Function
End If
Next
End If
End Function
Of course it might be useful to be able to go the other way: Get a
sheetname belonging to a specific Id:
Public Function
GetSheetNameFromId(sId As
String) As
String
'-------------------------------------------------------------------------
' Procedure : GetSheetNameFromId
' Company : JKP Application Development Services
(c)
' Author : Jan Karel Pieterse
' Created : 6-5-2009
' Purpose : Returns the sheetname belonging to a
sheetId
'-------------------------------------------------------------------------
Dim oXMLDoc As
MSXML2.DOMDocument
Dim oXMLNode As
MSXML2.IXMLDOMNode
Dim oXMLNodeList As
MSXML2.IXMLDOMNodeList
If mvXLFolder <> ""
Then
Set oXMLDoc =
New MSXML2.DOMDocument
oXMLDoc.Load XLFolder & "workbook.xml"
Set oXMLNodeList =
oXMLDoc.SelectNodes("/workbook/sheets/sheet")
For Each
oXMLNode In oXMLNodeList
If
oXMLNode.Attributes.getNamedItem("r:id").nodeValue = "rId" &
Val(sId) + 1 Then
GetSheetNameFromId =
oXMLNode.Attributes.getNamedItem("name").nodeValue
'Got it, get out
Exit
Function
End If
Next
End If
End Function
How to use the class module
In a normal module (called modDemo) I have demonstrated how the class
module may be put to use:
Public Sub
Demo()
'-------------------------------------------------------------------------
' Procedure : Demo
' Company : JKP Application Development Services
(c)
' Author : Jan Karel Pieterse (jkp-ads.com)
' Created : 06-05-2009
' Purpose : Demonstrates getting something from
an OpemXML file
'-------------------------------------------------------------------------
Dim cEditOpenXML As
clsEditOpenXML
Dim sXML As
String
Set cEditOpenXML =
New clsEditOpenXML
With cEditOpenXML
'Tell it which OpenXML file to process
.SourceFile = ThisWorkbook.Path & "\formcontrols.xlsm"
'Before you can access info in the file,
it must be unzipped
.UnzipFile
'Tell it which sheet you want to change
.Sheet2Change = "MySheet"
'Get XML from the sheet's xml file
sXML = .GetXMLFromFile(.SheetFileName)
'Change the xml of the sheet here
'Now write the xml back to the sheet:
'.WriteXML2File sXML, .SheetFileName
'Now rezip the unzipped package
.ZipAllFilesInFolder
End With
'Only when you let the class go out of scope
the zip file's .zip extension is removed
'in the terminate event of the class.
'Then the OpenXML file has its original
filename back.
Set cEditOpenXML =
Nothing
End Sub
Conclusion
The code shown in this article and
in the associated download file shows you a way to extract content
from the Office 2007 OpenXML file format and even enables you to edit
parts of the content.
Of course it is up to you to keep everything nice and tidy and adhere
to the rules of the OpenXML file format specification.
See this article for more information about the format.
