PDA

View Full Version : ایجاد بانک اطلاعاتی اکسس با استفاده از کد vb



fireman
پنج شنبه 25 بهمن 1386, 22:34 عصر
با سلام
لطفاً‌ راهنمایی کنید .
سوال: من می خواهم کدی را بنویسم که در تاریخ 1/1/هرسالی (از سال 87 به بعد)‌12 بانک اطلاعاتی از نوع (اکسس97)‌ که در هرکدام 30 یا 31 tabel و در هر tabel ،‌ تعداد 10 فیلد ایجاد کنم (تمامی 12 بانک باید در دایرکتوری به نام (شماره همان سال ) dbase
(مثل 87 dbase)‌ ذخیره شوند .این کد باید در ابتدای هر سال 1/1/هر سال در صورت وارد شدن به برنامه تشخیص داده و عمل کند (فقط برای یک بار) این روند باید در هر سال اتفاق بیفتد؟

Mbt925
پنج شنبه 25 بهمن 1386, 23:10 عصر
به نمونه های زیر یه نگاهی بندازید:



Public Function CreateDatabase(DBFullPath As String, InitialTable As String) As Boolean

'PURPOSE: Creates an access database, with one table. The
'table will have one numeric field, ID

'PARAMETERS: DBFULLPATH: FileName/Path of database to create
'InitialTable: Name of table to create

'RETURNS: TRUE IF SUCCESSFUL, FALSE OTHERWISE

Dim db As Database
Dim td As TableDef
Dim f As Field

On Error GoTo ErrorHandler
Set db = DBEngine.CreateDatabase(DBFullPath, dbLangGeneral)
Set td = db.CreateTableDef(InitialTable)
Set f = td.CreateField("ID", dbLong)
td.Fields.Append f
db.TableDefs.Append td

CreateDatabase = True
ErrorHandler:
If Not db Is Nothing Then db.Close

End Function

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;"
' Engine Type=5 = Access 2000 Database
' Engine Type=4 = Access 97 Database
Set catNewDB = Nothing
End Sub

Sub CreateAccessTable(sDatabaseToCreate)

Dim catDB As ADOX.Catalog
Dim tblNew As ADOX.Table
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 = "Contacts"

' 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
Set col = New ADOX.Column

With col
.ParentCatalog = catDB
.Type = adInteger ' adText does not exist
.Name = "ID"
.Properties("Autoincrement") = True
.Properties("Description") = "I am the Description " & _
"for the column"
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 "NumberColumn", adInteger
.Append "FirstName", adVarWChar
.Append "LastName", adVarWChar
.Append "Phone", adVarWChar
.Append "Notes", adLongVarWChar
End With

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("FirstName")
.Attributes = adColNullable
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
Set catDB = Nothing
End Sub

Private Sub Form_Load()
Dim sDatabaseName As String
sDatabaseName = "C:\MyNewDatabase.mdb"
' First call the Create Database method
CreateAccessDatabase sDatabaseName
' Then add a table and columns to this database
CreateAccessTable sDatabaseName
MsgBox "Database has been created successfully!"
End Sub
اینجا هم نمونه ی خوبی معرفی شده:

http://imar.spaanjaars.com/QuickDocID.aspx?QUICKDOC=143

vbhamed
جمعه 26 بهمن 1386, 00:43 صبح
سلام
گاهی راههای ساده تری هم هست
همراه برنامتون 12 عدد بانک اطلاعاتی خالی توی یک پوشه مثل Template داشته باشید و اول هر سال همه 12 تا بانک رو در داخل پوشه مربوط به همون سال کپی کنید و قبل از کپی چک کنید که فایلها وجود نداشته باشن تا یه موقع رونویسی نشن