[دمعة فرح]

اخواني الافاضل
السلام عليكم و رحمة الله وبركاته
فائدة اردت ان اشاركم بها و هي كيفية انشاء قاعدة بيانات عن طريق ال ADO


Code:
--------------------------------------------------------------------------------

Make sure that you add the falwing References
<-- Microsoft ADO Ext. 2.6 for DDL and Security
<-- Microsoft ActiveX Data ******s Recorset 2.6 Library

<------- Form1 as Form
<------------- ****1 as ****Box
<------------- ****2 as ****Box
<------------- cmdCreaData as CommandButton
<------------- CmdCreatTable as CommandButton

Private Sub cmdCreateData_Click()
If (CreateDatabase(****1.****) = True) Then
MsgBox "Database Successfully Created "
Else
MsgBox "Error in Createing, Databse is not Created"
End If
End Sub

Private Sub CmdCreatTable_Click()
If (CreateAutoIncrColumn(****2.****) = True) Then
MsgBox "Table Successfully Created "
Else
MsgBox "Error in Createing, Table is not Created"
End If
End Sub
Function CreateDatabase(DatabaseName As String) As Boolean
On Error GoTo TqDbError
Dim cat As New ADOX.Catalog
'Dim cat As New ADOMD.Catalog

cat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & App.Path & "" & Trim(DatabaseName) & ".mdb"
CreateDatabase = True
Exit Function
TqDbError:
CreateDatabase = False
MsgBox "error :" & Trim(Str(Err.Number)) & " " & Err.De******ion
End Function
Function CreateAutoIncrColumn(TableName As String) As Boolean

Dim cat As New ADOX.Catalog
Dim tbl As New ADOX.Table
Dim col As New ADOX.Column

On Error GoTo TqTableError
' Open the catalog
cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & App.Path & "" & ****1.**** &".mdb;"

With tbl
.Name = TableName
Set .ParentCatalog = cat
' Create fields and append them to the new Table ******.
.Columns.Append "ContactId", adInteger
' Make the ContactId column and auto incrementing column
.Columns("ContactId").Properties("AutoIncrement") = True
.Columns.Append "CustomerID", adInteger
.Columns.Append "FirstName", adVarWChar, 15
.Columns.Append "LastName", adVarWChar, 25
.Columns.Append "Phone", adVarWChar, 20
.Columns.Append "Salary", adCurrency
.Columns.Append "Birthdate", adDate
.Columns.Append "Notes", adLongVarWChar
End With

cat.Tables.Append tbl

Set cat = Nothing
CreateAutoIncrColumn = True
Exit Function
TqTableError:
CreateAutoIncrColumn = False
MsgBox "error :" & Trim(Str(Err.Number)) & " " & Err.De******ion
Exit Function
End Function

تحياتي

دمعة فرح