Notes Database Backup ZIP Agent

Use this code in a (scheduled) agent to zip a selected set of Notes databases to a backup location

Replicate (or copy) databases to a temp directory
Zip the newly created databases to a backup directory
Cleanup the temp directory

To reduce complexity and set the main focus on the creation of replica’s and zip files, the following changes were made to the initial code:

only one hard-coded directory (Applications) is backed up in a zip file. You can change this in the code, extend the number of directories, exclude certain files, etc.
the logging of the agent was removed (text file in the backup directory)

This agent uses a LotusScript and a Java library

Java Library “zfmWrapper4LS”:

Import 2 files from this zip into the java library: zfmWrapper4LS.javalib:

Create a Java Library with title: zfmWrapper4LS
Import -> Archive -> ZipFileManager1_0.jar (from zip file above)
Import -> Java Source -> zfmWrapper4LS.java (from zip file above)
Delete Untitled.java
base class -> zfmWrapper4LS.class

LotusScript Library “slBackup”:

Copy code below into a LotusScript library called “slBackup”

Option Public
'Option Declare
UseLSX "*javacon"
Use "zfmWrapper4LS"
Class ZipFileManager
	Private jSession As JavaSession
	Private jError As JavaError
	Private zfmClass As JavaClass
	Private zfm As JavaObject
	Private ignoreSaveErrors As Boolean
	
	Public Sub New (fileName As String)
		Set jSession = New JavaSession
		Set zfmClass = jSession.GetClass("zfmWrapper4LS")
		Set zfm = zfmClass.CreateObject("(Ljava/lang/String;)V", fileName)
	End Sub
	
		Public Sub Delete ()
		If Not (zfm Is Nothing) Then
			Call zfm.close(False)
		End If
	End Sub
	
	Public Sub setRelativePath (pathName As String)
		Call zfm.setRelativePath(pathName)
	End Sub
	
	Public Function getEntryNames () As Variant
		getEntryNames = zfm.getEntryNames()
	End Function
	
	Public Function getNewEntryNames () As Variant
		getNewEntryNames = zfm.getNewEntryNames()
	End Function
	
	Public Function getNewFilesAdded () As Variant
		getNewFilesAdded = zfm.getNewFilesAdded()
	End Function
	
	Public Sub saveEntryAsFile (entryName As String, fileName As String)
		Call zfm.saveEntryAsFile(entryName, fileName)
	End Sub
	
	Public Sub removeEntry (entryName As String)
		Call zfm.removeEntry(entryName)
	End Sub
	
	Public Sub addEntry (fileName As String)
		Call zfm.addEntry(fileName)
	End Sub
	
	Public Sub addDirectoryEntry (dirName As String, howDeep As Integer, pattern As String)
		Call zfm.addDirectoryEntry(dirName, howDeep, pattern)
	End Sub
	
	Public Sub updateEntry (fileName As String)
		Call zfm.updateEntry(fileName)
	End Sub
	
	Public Sub updateDirectoryEntry (dirName As String, howDeep As Integer, pattern As String)
		Call zfm.updateDirectoryEntry(dirName, howDeep, pattern)
	End Sub
	
	Public Function getCurrentZipFileName (fileName As String) As String
		getCurrentZipFileName = zfm.getCurrentZipFileName()
	End Function
	
	Public Function getNewZipFileName (fileName As String) As String
		getNewZipFileName = zfm.getNewZipFileName()
	End Function
	
	Public Sub setNewZipFileName (fileName As String)
		Call zfm.setNewZipFileName(fileName)
	End Sub
	
	Public Sub setIgnoreSaveErrors (shouldIgnore As Boolean)
		ignoreSaveErrors = shouldIgnore
	End Sub
	
	Public Function processChanges () As String
		processChanges = zfm.processChanges(ignoreSaveErrors)
	End Function
	
	Public Function areChangesPending () As Boolean
		areChangesPending = zfm.areChangesPending()
	End Function
	
	Public Sub Close ()
		Call zfm.processChanges(ignoreSaveErrors)
		Call zfm.close(False)
	End Sub
	
	Public Function getDebugMessages () As Variant
		Dim msg As String
		msg = zfm.getDebugMessages()
		getDebugMessages = Split(msg, Chr(10))
	End Function
	
	Public Sub printDebugMessages ()
		Dim msgArray As Variant
		msgArray = getDebugMessages
		ForAll msg In msgArray
			Print Trim(msg)
		End ForAll
	End Sub
	
	Public Function getLastError () As Variant
		'** get any Java errors that occurred, and clear the Java error stack
		Set jError = jSession.getLastJavaError()
		getLastError = FullTrim(Split(jError.errorMsg &amp; Chr(10) &amp; jError.stackTrace, Chr(10)))
		jSession.ClearJavaError
	End Function
	
End Class
Private Function WinCreateFolder(psFolder As String) As Boolean
	Dim lsDrive As String
	Dim lsTemp As String
	Dim liPos As Integer
	Dim liLastPos As Integer
	
	On Error GoTo errorhandler
	
	lsDrive=Left$(psFolder,2)
	lsTemp=lsDrive+"\"
	liLastPos=4
	liPos=InStr(4,psFolder,"\")
	Do Until liPos=0
		lsTemp=lsTemp+Mid$(psFolder,liLastPos,(liPos-liLastPos))
		If Dir$(lsTemp,ATTR_DIRECTORY)="" Then 'it exists but is not a directory
			MkDir lsTemp
		End If
		liLastPos=liPos+1
		liPos=InStr(liLastPos,psFolder,"\")
		lsTemp=lsTemp+"\"
	Loop
	lsTemp=lsTemp+Mid$(psFolder,liLastPos)
	If Dir$(lsTemp,ATTR_DIRECTORY)="" Then
		MkDir lsTemp
	End If
	WinCreateFolder = True
	Exit Function
	
errorhandler:	
	Resume Next
End Function
Public Sub Backup
	Dim sn As New NotesSession
	Dim dbDir As NotesDbDirectory
	Dim dbCur As NotesDatabase
	Dim db As NotesDatabase
	Dim dbCopy As NotesDatabase
	Dim doccol As NotesDocumentCollection
	Dim doc As NotesDocument
	Dim strBackupDir As String
	Dim strTempDir As String
	Dim strAppDir As String
	Dim strFileCopy As String
	
	Print "Backup agent started"
	
	strBackupDir = "C:\Backup\"
	strTempDir = "C:\TempNotesDBs\"
	strAppDir = "Applications\" 'relative to Domino Data directory

	If Not WinCreateFolder(strBackupDir) Then
		Print "# folder " + strBackupDir + " cannot be created. Agent will quit."
		GoTo TheEnd
	End If

	If Not WinCreateFolder(strTempDir) Then
		Print "# folder " + strTempDir + " cannot be created. Agent will quit."
		GoTo TheEnd
	End If
	
	'Remove (remaining) replicated/copied databases from temp dir
	If sn.Isonserver Then
		Set dbCur = sn.Currentdatabase
		Call sn.SendConsoleCommand(dbCur.Server, "drop all")
		Sleep 2
		Call sn.SendConsoleCommand(dbCur.Server, "dbcache flush")
		Sleep 10		
	End If
	removeFilesAndFolders strTempDir

	Set dbDir = sn.GetDbDirectory("")
	Set db = dbDir.GetFirstDatabase(DATABASE)

	'Copy all databases you want to zip to the temporary location outside the Domino Data directory
	Do Until db Is Nothing
		If UCase(Left(db.Filepath, Len(strAppDir))) Like UCase(strAppDir) Then
			strFileCopy = strTempDir + strAppDir + StrRight(db.FilePath, strAppDir, 5)
			db.open "",""
			Set dbCopy = New NotesDatabase("","")
			If Not dbCopy.Open("", strFileCopy) Then
				'Create replica if file doesn't exist
				Set dbCopy = db.Createreplica("", strFileCopy)
				If dbCopy Is Nothing Then
					'If replica not allowed, create copy
					Set dbCopy = db.CreateCopy("", strFileCopy)
					Set doccol = db.Alldocuments
					Set doc = doccol.GetFirstDocument
					While Not doc Is Nothing
						Call doc.CopyToDatabase(dbCopy)
						Set doc = doccol.Getnextdocument(doc)
					Wend
				End If
				Set dbCopy = Nothing
			End If
		End If
		Set db = dbDir.Getnextdatabase()
	Loop
	
	Print "Zipping files..."
	zipFiles strBackupDir + "appdir.zip", strTempDir + strAppDir
	
	'Again, remove (remaining) replicated/copied databases from temp dir
	If sn.Isonserver Then
		Call sn.SendConsoleCommand(dbCur.Server, "drop all")
		Sleep 2
		Call sn.SendConsoleCommand(dbCur.Server, "dbcache flush")
		Sleep 10		
	End If
	removeFilesAndFolders strTempDir
	
TheEnd:
	Print "Backup agent finished"
	Exit Sub
End Sub
Private Sub RemoveFilesAndFolders(path As String)
	'Recursive lookup for folder/file structure
	'Delete files and remove folders
	
	Dim sn As New NotesSession
	Dim curDB As NotesDatabase
	Dim DirList As Variant
	Dim filename As String
	Dim filepath As String
	Dim sep As String
	Dim strDelFile As String
	Dim strDelFolder As String
	Dim strBaseDir As String
	
	On Error GoTo ErrorHandler
	On Error 75 GoTo PathFileAccessError 'Error when deleting file
	On Error 76 GoTo PathNotFound 'Error when deleting folder

	Set curDB = sn.CurrentDatabase
	
	If strBaseDir = "" Then
		strBaseDir = path
	End If

	If path &lt;&gt; "" Then 

		If InStr(sn.Platform, "Windows") &gt; 0 Then
			sep = "\"
		Else
			sep = "/"
		End If

		ReDim DirList(0)

		If InStr(path, sep) &gt; 0 Then
			filepath = StrLeftBack(path, sep)
		End If

		filename = Dir(path, 16)
		
		While filename &lt;&gt; ""
			If filename &lt;&gt; "." And filename &lt;&gt; ".." Then
				If GetFileAttr(filepath &amp; sep &amp; filename) = 16 Then
					'This is a directory
					DirList = ArrayAppend(DirList, filepath &amp; sep &amp; filename &amp; sep)
				Else
					If filepath &lt;&gt; strBaseDir Then
						'Delete file
						strDelFile = filepath &amp; sep &amp; filename
						Kill strDelFile
					End If
				End If
			End If
			filename = Dir
		Wend 
		
		DirList = FullTrim(DirList)

		ForAll dirpath In DirList
			RemoveFilesAndFolders(dirpath)
			If Len(dirpath) &gt; 0 Then
				strDelFolder = Left(dirpath, Len(dirpath) - 1)
				If strDelFolder &lt;&gt; strBaseDir Then
					RmDir strDelFolder
				End If
			End If
		End ForAll
	End If
	Exit Sub

PathFileAccessError:
	Print "Cannot delete file: " + strDelFile
	Resume Next
	Exit Sub
	
PathNotFound:
	Print "Cannot delete folder: " + strDelFolder
	Resume Next
	Exit Sub
	
ErrorHandler: 
	Print "Error in RemoveFilesAndFolders"
	Exit Sub
End Sub
Private Sub zipFiles (zipFileName As String, dirPath As String)
	On Error GoTo ErrorHandler
	
	Dim zipFile As New ZipFileManager(zipFileName)
	
	Call zipFile.setIgnoreSaveErrors(False)
	Call zipFile.setRelativePath(dirPath)
	Call zipFile.updateDirectoryEntry(dirPath, True, "*.nsf")
	Call zipFile.close
	
	Exit Sub

ErrorHandler:
	'** print any errors we get
	Dim stackTrace As Variant
	Dim zipError As String
	Dim strMsg As String
	Dim i As Integer
	
	If Not (zipFile Is Nothing) Then
		stackTrace = zipFile.getLastError
		zipError = stackTrace(0)
	End If
	
	If (zipError = "") Then
		Print "Error in script library Main, sub zipFiles"
	Else
		Print "# Java Error at line " &amp; Erl &amp; ": " &amp; zipError
		For i = 1 To UBound(stackTrace)
			Print stackTrace(i)
		Next
	End If
	Exit Sub
End Sub

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

277

278

279

280

281

282

283

284

285

286

287

288

289

290

291

292

293

294

295

296

297

298

299

300

301

302

303

304

305

306

307

308

309

310

311

312

313

314

315

316

317

318

319

320

321

322

323

324

325

326

327

328

329

330

331

332

333

334

335

336

337

338

339

340

341

342

343

344

345

346

347

Option Public

'Option Declare

UseLSX "*javacon"

Use "zfmWrapper4LS"

Class ZipFileManager

Private jSession As JavaSession

Private jError As JavaError

Private zfmClass As JavaClass

Private zfm As JavaObject

Private ignoreSaveErrors As Boolean

Public Sub New (fileName As String)

Set jSession = New JavaSession

Set zfmClass = jSession.GetClass("zfmWrapper4LS")

Set zfm = zfmClass.CreateObject("(Ljava/lang/String;)V", fileName)

End Sub

Public Sub Delete ()

If Not (zfm Is Nothing) Then

Call zfm.close(False)

End If

End Sub

Public Sub setRelativePath (pathName As String)

Call zfm.setRelativePath(pathName)

End Sub

Public Function getEntryNames () As Variant

getEntryNames = zfm.getEntryNames()

End Function

Public Function getNewEntryNames () As Variant

getNewEntryNames = zfm.getNewEntryNames()

End Function

Public Function getNewFilesAdded () As Variant

getNewFilesAdded = zfm.getNewFilesAdded()

End Function

Public Sub saveEntryAsFile (entryName As String, fileName As String)

Call zfm.saveEntryAsFile(entryName, fileName)

End Sub

Public Sub removeEntry (entryName As String)

Call zfm.removeEntry(entryName)

End Sub

Public Sub addEntry (fileName As String)

Call zfm.addEntry(fileName)

End Sub

Public Sub addDirectoryEntry (dirName As String, howDeep As Integer, pattern As String)

Call zfm.addDirectoryEntry(dirName, howDeep, pattern)

End Sub

Public Sub updateEntry (fileName As String)

Call zfm.updateEntry(fileName)

End Sub

Public Sub updateDirectoryEntry (dirName As String, howDeep As Integer, pattern As String)

Call zfm.updateDirectoryEntry(dirName, howDeep, pattern)

End Sub

Public Function getCurrentZipFileName (fileName As String) As String

getCurrentZipFileName = zfm.getCurrentZipFileName()

End Function

Public Function getNewZipFileName (fileName As String) As String

getNewZipFileName = zfm.getNewZipFileName()

End Function

Public Sub setNewZipFileName (fileName As String)

Call zfm.setNewZipFileName(fileName)

End Sub

Public Sub setIgnoreSaveErrors (shouldIgnore As Boolean)

ignoreSaveErrors = shouldIgnore

End Sub

Public Function processChanges () As String

processChanges = zfm.processChanges(ignoreSaveErrors)

End Function

Public Function areChangesPending () As Boolean

areChangesPending = zfm.areChangesPending()

End Function

Public Sub Close ()

Call zfm.processChanges(ignoreSaveErrors)

Call zfm.close(False)

End Sub

Public Function getDebugMessages () As Variant

Dim msg As String

msg = zfm.getDebugMessages()

getDebugMessages = Split(msg, Chr(10))

End Function

Public Sub printDebugMessages ()

Dim msgArray As Variant

msgArray = getDebugMessages

ForAll msg In msgArray

Print Trim(msg)

End ForAll

End Sub

Public Function getLastError () As Variant

'** get any Java errors that occurred, and clear the Java error stack

Set jError = jSession.getLastJavaError()

getLastError = FullTrim(Split(jError.errorMsg & Chr(10) & jError.stackTrace, Chr(10)))

jSession.ClearJavaError

End Function

End Class

Private Function WinCreateFolder(psFolder As String) As Boolean

Dim lsDrive As String

Dim lsTemp As String

Dim liPos As Integer

Dim liLastPos As Integer

On Error GoTo errorhandler

lsDrive=Left$(psFolder,2)

lsTemp=lsDrive+"\"

liLastPos=4

liPos=InStr(4,psFolder,"\")

Do Until liPos=0

lsTemp=lsTemp+Mid$(psFolder,liLastPos,(liPos-liLastPos))

If Dir$(lsTemp,ATTR_DIRECTORY)="" Then 'it exists but is not a directory

MkDir lsTemp

End If

liLastPos=liPos+1

liPos=InStr(liLastPos,psFolder,"\")

lsTemp=lsTemp+"\"

Loop

lsTemp=lsTemp+Mid$(psFolder,liLastPos)

If Dir$(lsTemp,ATTR_DIRECTORY)="" Then

MkDir lsTemp

End If

WinCreateFolder = True

Exit Function

errorhandler:

Resume Next

End Function

Public Sub Backup

Dim sn As New NotesSession

Dim dbDir As NotesDbDirectory

Dim dbCur As NotesDatabase

Dim db As NotesDatabase

Dim dbCopy As NotesDatabase

Dim doccol As NotesDocumentCollection

Dim doc As NotesDocument

Dim strBackupDir As String

Dim strTempDir As String

Dim strAppDir As String

Dim strFileCopy As String

Print "Backup agent started"

strBackupDir = "C:\Backup\"

strTempDir = "C:\TempNotesDBs\"

strAppDir = "Applications\" 'relative to Domino Data directory

If Not WinCreateFolder(strBackupDir) Then

Print "# folder " + strBackupDir + " cannot be created. Agent will quit."

GoTo TheEnd

End If

If Not WinCreateFolder(strTempDir) Then

Print "# folder " + strTempDir + " cannot be created. Agent will quit."

GoTo TheEnd

End If

'Remove (remaining) replicated/copied databases from temp dir

If sn.Isonserver Then

Set dbCur = sn.Currentdatabase

Call sn.SendConsoleCommand(dbCur.Server, "drop all")

Sleep 2

Call sn.SendConsoleCommand(dbCur.Server, "dbcache flush")

Sleep 10

End If

removeFilesAndFolders strTempDir

Set dbDir = sn.GetDbDirectory("")

Set db = dbDir.GetFirstDatabase(DATABASE)

'Copy all databases you want to zip to the temporary location outside the Domino Data directory

Do Until db Is Nothing

If UCase(Left(db.Filepath, Len(strAppDir))) Like UCase(strAppDir) Then

strFileCopy = strTempDir + strAppDir + StrRight(db.FilePath, strAppDir, 5)

db.open "",""

Set dbCopy = New NotesDatabase("","")

If Not dbCopy.Open("", strFileCopy) Then

'Create replica if file doesn't exist

Set dbCopy = db.Createreplica("", strFileCopy)

If dbCopy Is Nothing Then

'If replica not allowed, create copy

Set dbCopy = db.CreateCopy("", strFileCopy)

Set doccol = db.Alldocuments

Set doc = doccol.GetFirstDocument

While Not doc Is Nothing

Call doc.CopyToDatabase(dbCopy)

Set doc = doccol.Getnextdocument(doc)

Wend

End If

Set dbCopy = Nothing

End If

Set db = dbDir.Getnextdatabase()

Loop

Print "Zipping files..."

zipFiles strBackupDir + "appdir.zip", strTempDir + strAppDir

'Again, remove (remaining) replicated/copied databases from temp dir

If sn.Isonserver Then

Call sn.SendConsoleCommand(dbCur.Server, "drop all")

Sleep 2

Call sn.SendConsoleCommand(dbCur.Server, "dbcache flush")

Sleep 10

End If

removeFilesAndFolders strTempDir

TheEnd:

Print "Backup agent finished"

Exit Sub

End Sub

Private Sub RemoveFilesAndFolders(path As String)

'Recursive lookup for folder/file structure

'Delete files and remove folders

Dim sn As New NotesSession

Dim curDB As NotesDatabase

Dim DirList As Variant

Dim filename As String

Dim filepath As String

Dim sep As String

Dim strDelFile As String

Dim strDelFolder As String

Dim strBaseDir As String

On Error GoTo ErrorHandler

On Error 75 GoTo PathFileAccessError 'Error when deleting file

On Error 76 GoTo PathNotFound 'Error when deleting folder

Set curDB = sn.CurrentDatabase

If strBaseDir = "" Then

strBaseDir = path

End If

If path <> "" Then

If InStr(sn.Platform, "Windows") > 0 Then

sep = "\"

Else

sep = "/"

End If

ReDim DirList(0)

If InStr(path, sep) > 0 Then

filepath = StrLeftBack(path, sep)

End If

filename = Dir(path, 16)

While filename <> ""

If filename <> "." And filename <> ".." Then

If GetFileAttr(filepath & sep & filename) = 16 Then

'This is a directory

DirList = ArrayAppend(DirList, filepath & sep & filename & sep)

Else

If filepath <> strBaseDir Then

'Delete file

strDelFile = filepath & sep & filename

Kill strDelFile

End If

filename = Dir

Wend

DirList = FullTrim(DirList)

ForAll dirpath In DirList

RemoveFilesAndFolders(dirpath)

If Len(dirpath) > 0 Then

strDelFolder = Left(dirpath, Len(dirpath) - 1)

If strDelFolder <> strBaseDir Then

RmDir strDelFolder

End If

End ForAll

End If

Exit Sub

PathFileAccessError:

Print "Cannot delete file: " + strDelFile

Resume Next

Exit Sub

PathNotFound:

Print "Cannot delete folder: " + strDelFolder

Resume Next

Exit Sub

ErrorHandler:

Print "Error in RemoveFilesAndFolders"

Exit Sub

End Sub

Private Sub zipFiles (zipFileName As String, dirPath As String)

On Error GoTo ErrorHandler

Dim zipFile As New ZipFileManager(zipFileName)

Call zipFile.setIgnoreSaveErrors(False)

Call zipFile.setRelativePath(dirPath)

Call zipFile.updateDirectoryEntry(dirPath, True, "*.nsf")

Call zipFile.close

Exit Sub

ErrorHandler:

'** print any errors we get

Dim stackTrace As Variant

Dim zipError As String

Dim strMsg As String

Dim i As Integer

If Not (zipFile Is Nothing) Then

stackTrace = zipFile.getLastError

zipError = stackTrace(0)

End If

If (zipError = "") Then

Print "Error in script library Main, sub zipFiles"

Else

Print "# Java Error at line " & Erl & ": " & zipError

For i = 1 To UBound(stackTrace)

Print stackTrace(i)

End If

Exit Sub

End Sub

Scheduled Agent

Create a weekly scheduled agent, that calls the Backup sub from the slBackup library

Make sure to apply the correct Security settings (run on behalf of server, and allow restricted operations)

Notes Database Backup ZIP Agent

Java Library “zfmWrapper4LS”:

LotusScript Library “slBackup”:

Scheduled Agent

You Might Also Like

Lotus Domino script snippet: Pinging a server to check if it is online

Lotus Domino script snippet finding readers fields in Notes documents

Lotus Domino script snippet create Windows Folder