Membuat aplikasi pembuat database ( Database Creator )

Kali ini penulis akan membuat aplikasi yang berfungsi untuk membuat database access dengan menggunakan visual basic. Dengan aplikasi ini diharapkan kalian bisa mengembangkan untuk membuat aplikasi yang lebih sempurna dan untuk mempermudah pembuatan database.
Berikut bentuk tampilan form, silakan kalian buat bentuk seperti contoh dibawah ini atau sesuai dengan ide yang kamu kembangkan sendiri.


Nah berikut kode scriptnya :

Dim eng As New DBEngine
Dim db As Database
Dim cn As ADODB.Connection
Dim rs As Recordset
Dim str As String
Dim fname As String
Dim fso As New FileSystemObject
' API DECLARATION OF SLEEP
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'API FUNCTION TO OPEN OUTLOOK EXPRESS
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Sub Check1_Click()

If Check1.Value = 0 Then
txtp1.Text = ""
txtp2.Text = ""
txtp1.BackColor = &H80000011
txtp2.BackColor = &H80000011
txtp1.Locked = True
txtp2.Locked = True
lblstrength.Width = 555
lblstrength.BackColor = &H8080FF
lblstrength.Caption = "Low"
Frame3.Visible = False
txtp1.TabStop = False
txtp2.TabStop = False
Else
txtp1.SetFocus
txtp1.BackColor = vbWhite
txtp2.BackColor = vbWhite
txtp1.Locked = False
txtp2.Locked = False
txtp1.TabStop = True
txtp2.TabStop = True
End If
End Sub

Private Sub Check1_LostFocus()
If Check1.Value = 0 Then
txtp1.TabStop = False
txtp2.TabStop = False
ElseIf Check1.Value = 1 Then
txtp1.TabStop = True
txtp2.TabStop = True
End If
End Sub

Private Sub Command1_Click()
On Error GoTo handler
If txtpath <> "" Then
If Check1.Value = 1 Then
validate
Else
create_database
status
str = MsgBox("Do u want to open database ?", vbQuestion + vbYesNo, "Open ?")
If str = vbYes Then ShellExecute Me.hwnd, "open", fname, "", "", 1
End If
Else
MsgBox "Select Path for Creating Database", vbInformation, "No Path..."
Command3.SetFocus
End If
Exit Sub
handler:
If Err.Number = 3204 Then
str = MsgBox("Database already exists" & vbCrLf & "Do U want to Repalce it ?", vbInformation + vbYesNo, "File alredy exists")
If str = vbYes Then
fso.DeleteFile (txtpath)
validate
Exit Sub
Else
txtpath.Text = ""
Command3.SetFocus
End If
Else
MsgBox Err.Description, vbInformation, "Info.."
Exit Sub
End If
End Sub

Private Sub Command2_Click()
On Error GoTo handler
ShellExecute Me.hwnd, "OPEN", "mailto:tomee@indosatcommunity.com ; tom_mee@telkom.net", "", "", 1
Exit Sub
handler:
MsgBox Err.Description, vbInformation, "Info.."
End Sub



Private Sub Command3_Click()
On Error GoTo handler
CommonDialog1.DialogTitle = "Create Database..."
CommonDialog1.Filter = "MS-Access files(*.mdb)|*.mdb"
CommonDialog1.ShowSave
txtpath.Text = CommonDialog1.FileName
Exit Sub
handler:
If Err.Number = 32755 Then
MsgBox "Don't U want to create database ?", vbQuestion, "Quit ?"
Else
MsgBox Err.Description, vbInformation, "Info..."
End If
End Sub

Private Sub Command4_Click()
On Error GoTo handler
ShellExecute Me.hwnd, "open", App.Path & "\notes.txt", "", "", 1
Exit Sub
handler:
MsgBox Err.Description, vbExclamation, "Error"
End Sub

Private Sub CommandButton1_Click()
Unload Me
End Sub

Private Sub Form_Load()
StatusBar1.Panels(2).Text = "STATUS"
txtp1.BackColor = &H80000011
txtp2.BackColor = &H80000011
End Sub


Private Sub status()
Picture1.Visible = True
For i = 0 To 7
Picture1.Picture = LoadPicture(App.Path & "\pics\" & i & ".BMP")
If i < text = "Database Created" text = "Table Created" visible =" False" text = "STATUS"> "" And txtp2.Text <> "" Then
If txtp1.Text <> txtp2.Text Then
MsgBox "Password doesn't match", vbCritical, "Password Mismatch"
txtp1.Text = ""
txtp2.Text = ""
txtp1.SetFocus
Else
create_database
status
str = MsgBox("Do u want to open database ?", vbQuestion + vbYesNo, "Open ?")
If str = vbYes Then ShellExecute Me.hwnd, "open", fname, "", "", 1
End If
Else
If Check1.Value = 1 Then
MsgBox "Password Mandatory", vbCritical, "Blank Password"
If txtp1.Text = "" Then
txtp1.SetFocus
Else
txtp2.SetFocus
End If
Else
create_database
status
str = MsgBox("Do u want to open database ?", vbQuestion + vbYesNo, "Open ?")
If str = vbYes Then ShellExecute Me.hwnd, "open", fname, "", "", 1
End If
End If
End Sub


Private Sub Return_to_normal()
txtp1.Text = ""
txtp2.Text = ""
txtpath.Text = ""
txtpath.SetFocus
Check1.Value = 0
Check1_Click
lblstrength.Width = 555
lblstrength.BackColor = &H8080FF
lblstrength.Caption = "Low"
Frame3.Visible = False
End Sub

Private Sub mnuabout_Click()
Form2.Show , Me
End Sub

Private Sub mnume_Click()
Form2.Show , Me
End Sub

Private Sub txtp1_Change()
Frame3.Visible = True
If Len(txtp1.Text) <= 5 Then lblstrength.Width = 555 lblstrength.BackColor = &H8080FF lblstrength.Caption = "Low" ElseIf Len(txtp1.Text) >= 6 And Len(txtp1.Text) <= 10 Then lblstrength.Width = 900 lblstrength.BackColor = &H80FFFF lblstrength.Caption = "Medium" ElseIf Len(txtp1.Text) > 10 Then
lblstrength.Width = 1605
lblstrength.BackColor = &H80FF80
lblstrength.Caption = "Strong"
End If
End Sub

Private Sub create_database()
fname = txtpath.Text
Set db = eng.Workspaces(0).CreateDatabase(txtpath, dbLangGeneral & ";pwd=" & Trim(txtp1.Text) & ";")
db.Close
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & txtpath.Text & ";persist security info=true ; jet oledb:database password =" & txtp1.Text & ";"
cn.Execute "create table Sample(empno number,ename text(50),sal number,date_of_birth date,date_of_joining date,constraint pk primary key(empno))"
cn.Close
End Sub

Private Sub txtp1_click()
move_focus
End Sub

Private Sub txtp2_click()
move_focus
End Sub


Private Sub move_focus()
If Check1.Value = 0 Then
Check1.SetFocus
Else
End If
End Sub

Nah selamat mencoba, bagi yang males membuat dan ingin mendownload silakan download disini