Skip to main content

Database name is "either invalid or currently in use"

Hello! I am trying to run the script which performs a joined database and summarisation. However, i am having issue with my summarisation where by the error message , i have try many ways to debug this but it doesn't seems to work. Wonder if anyone could kindly assist me on this! Thank you!

Option Explicit
Dim sFilename As String
Dim sFilename1 As String
Dim sFilename2 As String
Dim sjoinTb As String
Dim sjoinAll As String
Dim bExitScript As Boolean
Dim dbClose As String
Dim dbOpen As String
Dim dbGL As String
Dim dbGLsum As String

Sub Main
Call menu()
If Not bExitScript Then

Else
MsgBox "Script cancelled"
End If
client.RefreshFileExplorer
End Sub

Function menu()
Dim dlg As DialogDemo
Dim button As Integer

button = Dialog(dlg)
If button = 0 Then bExitScript = True
End Function

Function displayIt(ControlID$, Action%, SuppValue%)
Dim bExitMenu As Boolean

Select Case Action%
Case 1

Case 2
Select Case ControlID$

Case "btnFileSelect"
sFilename = selectFile() ' call for the function
If sFilename <> "" Then
Call selectField
DlgListBoxArray "DropListBox1", listbox1()
End If
Case "btnFileSelect1"
sFilename1 = selectFile1() ' call for the function
If sFilename1 <> "" Then
Call selectField1
DlgListBoxArray "DropListBox2", listbox2()
End If
Case "btnGLSelect"
sFilename2 = selectFile2()' call for the function
If sFilename2 <> "" Then
Call GLselect
DlgListBoxArray "DropListBox3", listbox3()
End If

If sFilename2 <> "" Then
Call GLselectsum
DlgListBoxArray "DropListBox4", listbox4()
End If

Case "btnJoinTB"
sjoinTb = joinTB() ' call for the function
'sjoinAll = sumGL() ' call for the function
If sjoinTB <> "" Then
Call joinTB()
'Call sumGL()
End If
Case "btnSum"
'sjoinTb = joinTB() ' call for the function
sjoinAll = sumGL() ' call for the function
If sjoinAll <> "" Then
'Call joinTB()
Call sumGL()
End If
Case "OKButton1"
bExitMenu = True
Case "CancelButton1"
bExitMenu = True
bExitScript = True
End Select
End Select

If bExitMenu Then
displayIt = 0
Else
displayIt = 1
End If

If sFilename = "" Then
DlgText "txtFilename", "Please select a file"
Else
DlgText "txtFilename", iSplit(sFilename, "","\",1, 1) ' start from left to right
End If

If sFilename1 = "" Then
DlgText "txtFilename1", "Please select a file"
Else
DlgText "txtFilename1", iSplit(sFilename1, "","\",1, 1) ' start from left to right

End If
If sFilename2 = "" Then
DlgText "txtGLname", "Please select a file"
Else
DlgText "txtGLname", iSplit(sFilename2, "","\",1, 1) ' start from left to right

End If

End Function

'select opening TB
Function selectFile() As String

Dim obj As Object
Set obj = Client.CommonDialogs
selectFile = obj.FileExplorer()
Set obj = Nothing 'always do this with Cilent.CommonDialogs

End Function

'select closing TB
Function selectFile1() As String

Dim obj As Object
Set obj = Client.CommonDialogs
selectFile1 = obj.FileExplorer()
Set obj = Nothing 'always do this with Cilent.CommonDialogs

End Function

'select GL
Function selectFile2() As String

Dim obj As Object
Set obj = Client.CommonDialogs
selectFile2 = obj.FileExplorer()
Set obj = Nothing 'always do this with Cilent.CommonDialogs

End Function

'function when select opening TB DDL
Function selectField()
Dim db As database
Dim table As table
Dim field As field
Dim i As Integer
Dim bFirstTime As Boolean

Set db = Client.OpenDatabase(sFilename)
Set table = db.TableDef
bFirstTime = True
For i = 1 To table.count
Set field = table.GetFieldAt(i)
If bFirstTime Then
bFirstTime = False
ReDim listbox1(1)
listbox1(1) = field.name
dbOpen = field.name
MsgBox dbOpen
Else
ReDim preserve listbox1(UBound(listbox1) + 1)
listbox1(UBound(listbox1)) = field.name
End If
Next i
Set field = Nothing
Set table = Nothing
db.close
Set db = Nothing

End Function

'function when select closing TB DDL
Function selectField1()
Dim db As database
Dim table As table
Dim field As field
Dim i As Integer
Dim bFirstTime As Boolean

Set db = Client.OpenDatabase(sFilename1)
Set table = db.TableDef
bFirstTime = True
For i = 1 To table.count
Set field = table.GetFieldAt(i)
If bFirstTime Then
bFirstTime = False
ReDim listbox2(1)
listbox2(1) = field.name
dbClose = field.name
MsgBox dbClose
Else
ReDim preserve listbox2(UBound(listbox2) + 1)
listbox2(UBound(listbox2)) = field.name
End If
Next i
Set field = Nothing
Set table = Nothing
db.close
Set db = Nothing

End Function

'function when select GL to populate DDL field for field to sum
Function GLselect()
Dim db As database
Dim table As table
Dim field As field
Dim i As Integer
Dim bFirstTime As Boolean

Set db = Client.OpenDatabase(sFilename2)
Set table = db.TableDef
bFirstTime = True
For i = 1 To table.count
Set field = table.GetFieldAt(i)
If field.IsCharacter Then
If bFirstTime Then
bFirstTime = False
ReDim listbox3(1)
'listbox3(1) = field.name
'dbGL = field.name
listbox3(1) = field.name
dbGL = field.name
MsgBox dbGL
Else
ReDim preserve listbox3(UBound(listbox3) + 1)
listbox3(UBound(listbox3)) = field.name
End If
End If
Next i
Set field = Nothing
Set table = Nothing
db.close
Set db = Nothing

End Function

'function when select GL to populate DDL field for numeric
Function GLselectsum()
Dim db As database
Dim table As table
Dim field As field
Dim i As Integer
Dim bFirstTime As Boolean

ReDim listbox4(0)
bFirstTime = True

Set db = Client.OpenDatabase(sFilename2)
Set table = db.TableDef
For i = 1 To table.count
Set field = table.GetFieldAt(i)
If field.IsNumeric Then
If bFirstTime Then
bFirstTime = False
listbox4(0) = field.name
dbGLsum = field.name
MsgBox dbGLsum
Else
ReDim preserve listbox4(UBound(listbox4) + 1)
listbox4(UBound(listbox4)) = field.name
End If
End If
Next i
Set field = Nothing
Set table = Nothing
db.close
Set db = Nothing

End Function

Function joinTB()
Dim db As database
Dim task As String
Dim dbName As String

Set db = Client.OpenDatabase(sFilename)
Set task = db.JoinDatabase
task.FileToJoin sFilename1
task.IncludeAllPFields
task.IncludeAllSFields
task.AddMatchKey dbOpen, dbClose,"A"
task.CreateVirtualDatabase = False
'name of the join TB
dbName = client.uniqueFilename("working")
task.PerformTask dbName, "", WI_JOIN_ALL_REC
Set task = Nothing
Set db = Nothing
Client.OpenDatabase (dbName)

End Function

'summarise GL

Function sumGL()
Dim db As database
Dim task As String
Dim dbName As String

Set db = Client.OpenDatabase(sFilename2)

MsgBox sFilename2
Client.RefreshFileExplorer
Set task = db.Summarization
task.AddFieldToSummarize dbGLsum
task.AddFieldToTotal dbGLsum

dbName = client.uniqueFilename("workingsum")
Client.RefreshFileExplorer
task.OutputDBName = dbName
task.CreatePercentField = FALSE
task.StatisticsToInclude = SM_SUM
Set task = Nothing
Set db = Nothing
MsgBox dbName
Client.OpenDatabase (dbName) <- error here

End Function

Brian Element Tue, 10/27/2020 - 07:52
Is it actually performing the summary? You have a MsgBox for the dbName, is it populate with an actual file name (can you see it in the file explorer if you do a refresh). It is hard to tell without running the file with some data to see what is going on.

yanjiao Tue, 10/27/2020 - 09:22

In reply to by Brian Element

Hi Brian

Thanks for the reply! I am just testing msgbox for dbName to see if it is calling the correct db. The file name "workingsum" isn't showing. Sorry, i have uploaded the iss file together with the excel i am using.

Brian Element Tue, 10/27/2020 - 10:52

In reply to by yanjiao

Thanks for the files, I was able to spot the problem right away. You are missing the performTask function before you close the variables. So put this line before the Set task = Nothing line

task.PerformTask
The website encountered an unexpected error. Try again later.