No. of Records in Multiple database

jyotikumar

Forums

Is there any way to crate a list of databases name and count the no. of records in each database of a folder?

Brian Element Sun, 07/03/2022 - 11:14

Yes, you can use the ProjectManagement.Databases() to get a list of databases and then loop through each one and get the number of records.  What type of output are you looking for?

Brian Element Tue, 07/26/2022 - 09:13

Here is some code that will place the filenames and the filesizes into two arrays.  It uses the project folder for its base so if you only want items from a subfolder you will have to filter those out.


Option Explicit

Dim sFilenames() As String
Dim lFileSizes() As Long

Sub Main
	Dim i As Integer
	Dim msg As String
	Call getFilenames()
	Call getFilesizes()
	For i = 0 To UBound(sFilenames)
		msg = msg & sFilenames(i) & " (" & lFileSizes(i) & ")" &Chr(13)
	Next i
	MsgBox msg
End Sub

Function getFilesizes()
	Dim i As Integer
	Dim db As database
	
	ReDim lFileSizes(UBound(sFilenames))
	
	For i = 0 To UBound(sFilenames)
		Set db = client.opendatabase(sFilenames(i))
		lFileSizes(i) = db.count
		db.close
	Next i
	
	Set db = Nothing
End Function

Function getFilenames()
	Dim task As task
	Dim collection As collection
	Dim bFirstItem As Boolean
	Dim filename As String
	
	Set task = client.ProjectManagement
	Set collection = task.Databases
	
	bFirstItem = True
	
	For Each filename In collection
		If bFirstItem Then
			bFirstItem = False
			ReDim sFilenames(0)
			sFilenames(0) = filename
		Else
			ReDim preserve sFilenames(UBound(sFilenames) + 1)
			sFilenames(UBound(sFilenames)) = filename
		End If
	Next
	
	Set collection = Nothing
	Set task = Nothing
End Function

Brian Element Thu, 08/17/2023 - 14:29

Hi jyotikumar,

I updated the code so it now outputs to an IDEA database.


Option Explicit

Dim sFilenames() As String
Dim lFileSizes() As Long
Dim sFilename As String

Sub Main
	Call getFilenames()
	Call getFilesizes()
	call createDatabase()
	Call addData()
	
End Sub

Function addData()
	Dim db As database
	Dim table As table
	Dim rs As RecordSet
	Dim rec As Record
	
	Dim i As Integer
	
	Set db = client.opendatabase(sFilename)
	Set table = db.TableDef
	
	table.Protect = False
	
	Set rs = db.RecordSet
	
	For i = 0 To UBound(sFilenames)
		Set rec = rs.NewRecord
		rec.SetCharValue "FILENAME", sFilenames(i) 
		rec.SetNumValue "FILESIZE", lFileSizes(i)
		rs.Appendrecord rec
	Next i
	
	table.Protect = True
	
	db.CommitDatabase
	
	Set rs = Nothing
	Set table = Nothing
	db.close
	Set db = Nothing
	
	client.OpenDatabase(sFilename)
End Function

Function createDatabase()
	Dim db As database
	Dim table As table
	Dim field As field
	
	Set table = client.NewTableDef
	Set field = table.NewField
	field.Name = "FILENAME"
	field.Type = WI_CHAR_FIELD
	field.Length = 100
	field.Description = ""
	table.AppendField field
	
	Set field = table.NewField
	field.Name = "FILESIZE"
	field.Type = WI_NUM_FIELD
	field.Decimals = 0
	field.Description = ""
	table.AppendField field
	
	sFilename = client.UniqueFileName("Filename and Size")
	Set db = client.NewDatabase(sFilename, "", table)
	
	Set field = Nothing
	Set table = Nothing
	Set db = Nothing
End Function

Function getFilesizes()
	Dim i As Integer
	Dim db As database
	
	ReDim lFileSizes(UBound(sFilenames))
	
	For i = 0 To UBound(sFilenames)
		Set db = client.opendatabase(sFilenames(i))
		lFileSizes(i) = db.count
		db.close
	Next i
	
	Set db = Nothing
End Function

Function getFilenames()
	Dim task As task
	Dim collection As collection
	Dim bFirstItem As Boolean
	Dim filename As String
	
	Set task = client.ProjectManagement
	Set collection = task.Databases
	
	bFirstItem = True
	
	For Each filename In collection
		If bFirstItem Then
			bFirstItem = False
			ReDim sFilenames(0)
			sFilenames(0) = filename
		Else
			ReDim preserve sFilenames(UBound(sFilenames) + 1)
			sFilenames(UBound(sFilenames)) = filename
		End If
	Next
	
	Set collection = Nothing
	Set task = Nothing
End Function