Hi All,
When i Create a New File of Access 2003 Database it is show me a "Run Time Error -2147217865(80040e37) - Can not find a Table or Constraint". I am checking all the possible thing also check that connection is also running ok and also check in references that all thing is there after that why it is show me this Error I don't Know so Please Help me ....................... my whole code of Create a new file is as under. Please guide me where i am wrong so that in future i learn this things.....................Thank you very Much.
Private Sub cmdOk_Click()
Dim sDatabaseName As String
sDatabaseName = "e:\Mehta TDS/Data/" & Trim(txtNew.Text) & ".mtf"
' First call the Create Database method
CreateAccessDatabase sDatabaseName
' Then add a table and columns to this database
CreateAccessTable sDatabaseName
MsgBox "File created successfully!"
End Sub
Sub CreateAccessDatabase(sDatabaseToCreate)
Dim catNewDB As ADOX.Catalog
Set catNewDB = New ADOX.Catalog
catNewDB.Create "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & sDatabaseToCreate & _
";Jet OLEDB:Engine Type=5;"
Set catNewDB = Nothing
End Sub
Sub CreateAccessTable(sDatabaseToCreate)
Dim catDB As ADOX.Catalog
Dim tblNew As ADOX.Table
Dim cn As ADODB.Connection
Set catDB = New ADOX.Catalog
' Open the catalog
catDB.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & sDatabaseToCreate
' Create new Table
Set tblNew = New ADOX.Table
tblNew.Name = "DedctrMaster"
' First Create an Autonumber column, called ID.
' This is just for demonstration purposes.
' We could have done this below with all the other
' columns as well
Dim col As ADOX.Column
Dim prp As ADOX.Property
Set col = New ADOX.Column
With col
.ParentCatalog = catDB
.Type = adVarWChar ' adText does not exist
.Name = "Name"
'.Properties("Jet OLEDB:Required").Value = False
End With
tblNew.Columns.Append col
' Now add the rest of the columns
With tblNew
' Create fields and append them to the
' Columns collection of the new Table object.
With .Columns
'.Append "Name", adVarWChar
.Append "Brdiv", adVarWChar, 50
.Append "Flatno", adVarWChar, 50
.Append "Bldgnm", adVarWChar, 50
.Append "Rdnm", adVarWChar, 50
.Append "Area", adVarWChar, 50
.Append "City", adVarWChar, 50
.Append "State", adVarWChar, 50
.Append "Pin", adVarWChar, 50
.Append "Addch", adVarWChar, 50
.Append "Telecode", adVarWChar, 50
.Append "Teleno", adVarWChar, 50
.Append "Telecode1", adVarWChar, 50
.Append "Teleno1", adVarWChar, 50
.Append "Fax", adVarWChar, 50
.Append "Email", adVarWChar, 50
.Append "Email1", adVarWChar, 50
.Append "Resgender", adVarWChar, 50
.Append "Resname", adVarWChar, 50
.Append "Resdesig", adVarWChar, 50
.Append "Resfnm", adVarWChar, 50
.Append "Resflatno", adVarWChar, 50
.Append "Resbldgnm", adVarWChar, 50
.Append "Resrdnm", adVarWChar, 50
.Append "Resarea", adVarWChar, 50
.Append "Rescity", adVarWChar, 50
.Append "Resstate", adVarWChar, 50
.Append "Respin", adVarWChar, 50
.Append "Resaddch", adVarWChar, 50
.Append "Restelecode", adVarWChar, 50
.Append "Resteleno", adVarWChar, 50
.Append "Restelecode1", adVarWChar, 50
.Append "Resteleno1", adVarWChar, 50
.Append "Resmob", adVarWChar, 50
.Append "Resfax", adVarWChar, 50
.Append "Resemail", adVarWChar, 50
.Append "Resemail1", adVarWChar, 50
.Append "PAN", adVarWChar, 50
.Append "TAN", adVarWChar, 50
.Append "Fnyr1", adVarWChar, 50
.Append "Fnyr2", adVarWChar, 50
.Append "Asyr1", adVarWChar, 50
.Append "Asyr2", adVarWChar, 50
.Append "Etdsa", adVarWChar, 50
.Append "Retyp", adVarWChar, 50
.Append "Status", adVarWChar, 50
.Append "Dedtyp", adVarWChar, 50
.Append "AIN", adVarWChar, 50
.Append "AState", adVarWChar, 50
.Append "PAO", adVarWChar, 50
.Append "PAOreg", adVarWChar, 50
.Append "DDO", adVarWChar, 50
.Append "DDOreg", adVarWChar, 50
.Append "Ministry", adVarWChar, 50
.Append "Oth", adVarWChar, 50
End With
For Each col In tblNew.Columns
For Each prp In col.Properties
If col.Name <> "Brdiv" Then
col.Properties("Jet OLEDB:Required").Value = False
End If
Next
Next
Set cn = catDB.ActiveConnection
SetColumnToNullable cn, "tblNew", "Brdiv", "VARCHAR(50)"
Dim adColNullable ' Is not defined in adovbs.inc,
' so we need to define it here.
' The other option is adColFixed with a value of 1
adColNullable = 2
With .Columns("Brdiv")
.Attributes = adColNullable
'.Properties("Required") = False
End With
End With
' Add the new Table to the Tables collection of the database.
catDB.Tables.Append tblNew
Set col = Nothing
Set tblNew = Nothing
''''''''Employee Master Table and Columns'''''''''''''''
Dim tblNew1 As ADOX.Table
Set tblNew1 = New ADOX.Table
tblNew1.Name = "EmpMaster"
Dim col1 As ADOX.Column
Set col1 = New ADOX.Column
With col1
.ParentCatalog = catDB
.Type = adInteger ' adText does not exist
.Name = "Srno"
End With
tblNew1.Columns.Append col1
With tblNew1
With .Columns
.Append "Name", adVarWChar
.Append "Flatno", adVarWChar
.Append "Bldgnm", adVarWChar
.Append "Rdnm", adVarWChar
.Append "Area", adVarWChar
.Append "City", adVarWChar
.Append "State", adVarWChar
.Append "Pin", adVarWChar
.Append "BD", adVarWChar
.Append "Directr", adVarWChar
.Append "Gender", adVarWChar
.Append "Desig", adVarWChar
.Append "Frdt", adVarWChar
.Append "Todt", adVarWChar
.Append "Mob", adVarWChar
.Append "Ph", adVarWChar
.Append "Email", adVarWChar
.Append "PAN", adVarWChar
.Append "Veripan", adVarWChar
End With
'Dim adColNullable
' adColNullable = 2
With .Columns("Name")
.Attributes = adColNullable
End With
End With
catDB.Tables.Append tblNew1
Set col1 = Nothing
Set tblNew1 = Nothing
'''''''Deductee Master Table and Coloumns''''''''''''''''''
Dim tblNew2 As ADOX.Table
Set tblNew2 = New ADOX.Table
tblNew2.Name = "DedcteeMaster"
Dim col2 As ADOX.Column
Set col2 = New ADOX.Column
With col2
.ParentCatalog = catDB
.Type = adInteger ' adText does not exist
.Name = "Srno"
End With
tblNew2.Columns.Append col2
With tblNew2
With .Columns
.Append "Title", adVarWChar
.Append "Name", adVarWChar
.Append "Flatno", adVarWChar
.Append "Bldgnm", adVarWChar
.Append "Rdnm", adVarWChar
.Append "Area", adVarWChar
.Append "City", adVarWChar
.Append "State", adVarWChar
.Append "Pin", adVarWChar
.Append "Mob", adVarWChar
.Append "Ph", adVarWChar
.Append "Email", adVarWChar
.Append "PAN", adVarWChar
.Append "Veripan", adVarWChar
.Append "Code", adVarWChar
End With
'Dim adColNullable
' adColNullable = 2
With .Columns("Title")
.Attributes = adColNullable
End With
End With
catDB.Tables.Append tblNew2
'cn.Close
Set col2 = Nothing
Set tblNew2 = Nothing
Set catDB = Nothing
End Sub
Private Sub SetColumnToNullable(ByRef AB As ADODB.Connection, ByVal pstrTableName As String, ByVal pstrColumnName As String, ByVal pstrDataType As String)
AB.Execute "ALTER TABLE " & pstrTableName & " ALTER COLUMN " & pstrColumnName & " " & pstrDataType & " NULL"
End Sub
When i Create a New File of Access 2003 Database it is show me a "Run Time Error -2147217865(80040e37) - Can not find a Table or Constraint". I am checking all the possible thing also check that connection is also running ok and also check in references that all thing is there after that why it is show me this Error I don't Know so Please Help me ....................... my whole code of Create a new file is as under. Please guide me where i am wrong so that in future i learn this things.....................Thank you very Much.
Private Sub cmdOk_Click()
Dim sDatabaseName As String
sDatabaseName = "e:\Mehta TDS/Data/" & Trim(txtNew.Text) & ".mtf"
' First call the Create Database method
CreateAccessDatabase sDatabaseName
' Then add a table and columns to this database
CreateAccessTable sDatabaseName
MsgBox "File created successfully!"
End Sub
Sub CreateAccessDatabase(sDatabaseToCreate)
Dim catNewDB As ADOX.Catalog
Set catNewDB = New ADOX.Catalog
catNewDB.Create "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & sDatabaseToCreate & _
";Jet OLEDB:Engine Type=5;"
Set catNewDB = Nothing
End Sub
Sub CreateAccessTable(sDatabaseToCreate)
Dim catDB As ADOX.Catalog
Dim tblNew As ADOX.Table
Dim cn As ADODB.Connection
Set catDB = New ADOX.Catalog
' Open the catalog
catDB.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & sDatabaseToCreate
' Create new Table
Set tblNew = New ADOX.Table
tblNew.Name = "DedctrMaster"
' First Create an Autonumber column, called ID.
' This is just for demonstration purposes.
' We could have done this below with all the other
' columns as well
Dim col As ADOX.Column
Dim prp As ADOX.Property
Set col = New ADOX.Column
With col
.ParentCatalog = catDB
.Type = adVarWChar ' adText does not exist
.Name = "Name"
'.Properties("Jet OLEDB:Required").Value = False
End With
tblNew.Columns.Append col
' Now add the rest of the columns
With tblNew
' Create fields and append them to the
' Columns collection of the new Table object.
With .Columns
'.Append "Name", adVarWChar
.Append "Brdiv", adVarWChar, 50
.Append "Flatno", adVarWChar, 50
.Append "Bldgnm", adVarWChar, 50
.Append "Rdnm", adVarWChar, 50
.Append "Area", adVarWChar, 50
.Append "City", adVarWChar, 50
.Append "State", adVarWChar, 50
.Append "Pin", adVarWChar, 50
.Append "Addch", adVarWChar, 50
.Append "Telecode", adVarWChar, 50
.Append "Teleno", adVarWChar, 50
.Append "Telecode1", adVarWChar, 50
.Append "Teleno1", adVarWChar, 50
.Append "Fax", adVarWChar, 50
.Append "Email", adVarWChar, 50
.Append "Email1", adVarWChar, 50
.Append "Resgender", adVarWChar, 50
.Append "Resname", adVarWChar, 50
.Append "Resdesig", adVarWChar, 50
.Append "Resfnm", adVarWChar, 50
.Append "Resflatno", adVarWChar, 50
.Append "Resbldgnm", adVarWChar, 50
.Append "Resrdnm", adVarWChar, 50
.Append "Resarea", adVarWChar, 50
.Append "Rescity", adVarWChar, 50
.Append "Resstate", adVarWChar, 50
.Append "Respin", adVarWChar, 50
.Append "Resaddch", adVarWChar, 50
.Append "Restelecode", adVarWChar, 50
.Append "Resteleno", adVarWChar, 50
.Append "Restelecode1", adVarWChar, 50
.Append "Resteleno1", adVarWChar, 50
.Append "Resmob", adVarWChar, 50
.Append "Resfax", adVarWChar, 50
.Append "Resemail", adVarWChar, 50
.Append "Resemail1", adVarWChar, 50
.Append "PAN", adVarWChar, 50
.Append "TAN", adVarWChar, 50
.Append "Fnyr1", adVarWChar, 50
.Append "Fnyr2", adVarWChar, 50
.Append "Asyr1", adVarWChar, 50
.Append "Asyr2", adVarWChar, 50
.Append "Etdsa", adVarWChar, 50
.Append "Retyp", adVarWChar, 50
.Append "Status", adVarWChar, 50
.Append "Dedtyp", adVarWChar, 50
.Append "AIN", adVarWChar, 50
.Append "AState", adVarWChar, 50
.Append "PAO", adVarWChar, 50
.Append "PAOreg", adVarWChar, 50
.Append "DDO", adVarWChar, 50
.Append "DDOreg", adVarWChar, 50
.Append "Ministry", adVarWChar, 50
.Append "Oth", adVarWChar, 50
End With
For Each col In tblNew.Columns
For Each prp In col.Properties
If col.Name <> "Brdiv" Then
col.Properties("Jet OLEDB:Required").Value = False
End If
Next
Next
Set cn = catDB.ActiveConnection
SetColumnToNullable cn, "tblNew", "Brdiv", "VARCHAR(50)"
Dim adColNullable ' Is not defined in adovbs.inc,
' so we need to define it here.
' The other option is adColFixed with a value of 1
adColNullable = 2
With .Columns("Brdiv")
.Attributes = adColNullable
'.Properties("Required") = False
End With
End With
' Add the new Table to the Tables collection of the database.
catDB.Tables.Append tblNew
Set col = Nothing
Set tblNew = Nothing
''''''''Employee Master Table and Columns'''''''''''''''
Dim tblNew1 As ADOX.Table
Set tblNew1 = New ADOX.Table
tblNew1.Name = "EmpMaster"
Dim col1 As ADOX.Column
Set col1 = New ADOX.Column
With col1
.ParentCatalog = catDB
.Type = adInteger ' adText does not exist
.Name = "Srno"
End With
tblNew1.Columns.Append col1
With tblNew1
With .Columns
.Append "Name", adVarWChar
.Append "Flatno", adVarWChar
.Append "Bldgnm", adVarWChar
.Append "Rdnm", adVarWChar
.Append "Area", adVarWChar
.Append "City", adVarWChar
.Append "State", adVarWChar
.Append "Pin", adVarWChar
.Append "BD", adVarWChar
.Append "Directr", adVarWChar
.Append "Gender", adVarWChar
.Append "Desig", adVarWChar
.Append "Frdt", adVarWChar
.Append "Todt", adVarWChar
.Append "Mob", adVarWChar
.Append "Ph", adVarWChar
.Append "Email", adVarWChar
.Append "PAN", adVarWChar
.Append "Veripan", adVarWChar
End With
'Dim adColNullable
' adColNullable = 2
With .Columns("Name")
.Attributes = adColNullable
End With
End With
catDB.Tables.Append tblNew1
Set col1 = Nothing
Set tblNew1 = Nothing
'''''''Deductee Master Table and Coloumns''''''''''''''''''
Dim tblNew2 As ADOX.Table
Set tblNew2 = New ADOX.Table
tblNew2.Name = "DedcteeMaster"
Dim col2 As ADOX.Column
Set col2 = New ADOX.Column
With col2
.ParentCatalog = catDB
.Type = adInteger ' adText does not exist
.Name = "Srno"
End With
tblNew2.Columns.Append col2
With tblNew2
With .Columns
.Append "Title", adVarWChar
.Append "Name", adVarWChar
.Append "Flatno", adVarWChar
.Append "Bldgnm", adVarWChar
.Append "Rdnm", adVarWChar
.Append "Area", adVarWChar
.Append "City", adVarWChar
.Append "State", adVarWChar
.Append "Pin", adVarWChar
.Append "Mob", adVarWChar
.Append "Ph", adVarWChar
.Append "Email", adVarWChar
.Append "PAN", adVarWChar
.Append "Veripan", adVarWChar
.Append "Code", adVarWChar
End With
'Dim adColNullable
' adColNullable = 2
With .Columns("Title")
.Attributes = adColNullable
End With
End With
catDB.Tables.Append tblNew2
'cn.Close
Set col2 = Nothing
Set tblNew2 = Nothing
Set catDB = Nothing
End Sub
Private Sub SetColumnToNullable(ByRef AB As ADODB.Connection, ByVal pstrTableName As String, ByVal pstrColumnName As String, ByVal pstrDataType As String)
AB.Execute "ALTER TABLE " & pstrTableName & " ALTER COLUMN " & pstrColumnName & " " & pstrDataType & " NULL"
End Sub