Menetukan target folder export data

Selanjutnya, di bab ini kita akan membahas bagaimana menentukan target folder penyimapanan export data access.

Sub command1_click()
On error resune next
Dim sfol as filedialog
Dim strfol as string

Set sfol = application.filedialog
Sfol.allowmultiselect = false
Sfol.show
Strfol = sfol.selecteditem(1)
If sfol = "" then
Else
Docmd transferspreadsheet .... Script ada di pembahasan sebelumnya
End if
End sub

Membuat datasheet subform auto size

Para pecinta programmer yang baca blog ini, kita akan membahas tentang bagaimana membuat subform data sheet auto size, sehingga pada saat form di kecilka  maka isi form juga akan mengecil sesuai dengan ukuran form.
Silahkan baca atau copas script nya...

Sub form_resize()
On error resume next
Subform1.width = me.windowwidth - (subform1.left + 300)
Subform1.height = me.windowheight - (subforn1.top + 1500) ' sisakan untuk button dibawahnya
Command1.left = subform1.left + (subforn1.width - command1.width)' supaya command button berada di sisi kana form

End sub

Selamat mencoba dan mengkreasikan lagi

Export table atau query data menggunakan transfer spread sheet

Para programmer yang handal2 sekalian, di sini saya akan kembali posting bagaimana caranya export table atau query data mengguakan perintah transfer spreadsheet yang sudah ada di Microsoft access database.

di sini akan dilengkapi dengan scripting runtime, tujuannya untuk menentukan target penyimpanan file export dengan membuat folder baru.

Sub Export_DataA()
On Error Resume Next
Dim fold
Dim filepath As String
Set fold = CreateObject("Scripting.FileSystemObject")
fold.createfolder "C:\My Database"
fold.createfolder "C:\My Database\My Export Data"
filepath = "C:\My Database\My Export Data\"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "Table_Roster" & Format(Date, "mmmm yyyy"), filepath & "my data.xls", 1

End Sub
Ok, maka data akan tersimpan di C:\My Database\My Export Data\My Data.xls

Salam...

Membuat Query Dengan Script

Ok, di bab ini kita akan bahas bagai mana membuat query dengan script dan memasukkan formula ke setiaf fields nya.
ini hanya query sederhana, selanjutnya kreasikan aja sendiri yak....

dan jika ada yang kurang di mengerti silahkan comment dan pasti akan di respon secepatnya...

Sub CreateQueryA()
On Error Resume Next
Dim db As Database
Dim qrydef As QueryDef
Dim mysql As String
Dim Skol As Long
Dim mulai As Long
Dim selesai As Long
Dim aformula1 As String
mulai = Format(Date, 0)
selesai = Format(Month(Date) & "/1/" & Year(Date) + 1, 0)
For Skol = mulai To selesai
If Format(Skol, "d") = 1 Then
aformula1 = aformula1 & ", IIF(Format([tglcuti],0) = " & Skol & ",0,1) As [" & Format(Skol, "mmm-yy") & "]"
End If
Next Skol
mysql = "Select [nama], [jabatan], [departement], [level], [tglmasuk], [tglcuti]" & aformula1 & " from [Table_Roster" & Format(Date, "mmmm yyyy") & "]"
Set db = CurrentDb()
db.QueryDefs.Delete "Query1"
Set qrydef = db.CreateQueryDef("Query1", mysql)
Debug.Print mysql
End Sub
Salam...

Form Input 1

Membuat form input untuk mengupdate data ke database :

Option Compare Database
Private Sub Command12_Click()
DoCmd.GoToRecord acDataForm, Me.Name, acNewRec
End Sub
Private Sub Command13_Click()
DoCmd.GoToRecord acDataForm, Me.Name, acNext
End Sub
Private Sub Command14_Click()
DoCmd.GoToRecord acDataForm, Me.Name, acPrevious
End Sub
Private Sub Command15_Click()
DoCmd.RunCommand acCmdDeleteRecord
End Sub

'Connection di mulai saat form di load
Private Sub Form_Load()
On Error Resume Next
Dim db As Database
Dim dbr As Recordset
Set db = CurrentDb
Set dbr = db.OpenRecordset("Select * from [Table_Roster" & Format(Date, "mmmm yyyy") & "]")
Set Me.Recordset = dbr
tnama.ControlSource = "nama"
tjabatan.ControlSource = "jabatan"
tdepartement.ControlSource = "departement"
tlevel.ControlSource = "level"
ttglmasuk.ControlSource = "tglmasuk"
ttglcuti.ControlSource = "tglcuti"
End Sub
Private Sub ttglmasuk_AfterUpdate()
ttglcuti = ttglmasuk + 70
End Sub

Membuat duplikat tabel (temporary tabel) dengan cepat

Sub CreateTableDuplicateA()
On Error Resume Next
Dim db As Database
Dim dbr As Recordset
Dim tbldef As TableDef
Dim sKolom As Long
Set db = CurrentDb()
Set dbr = db.OpenRecordset("Select * from [Table_Roster" & Format(Date, "mmmm yyyy") & "]")
Set tbldef = db.CreateTableDef("Temp Table")
For sKolom = 0 To dbr.Fields.Count
With tbldef
.Fields.Append .CreateField(dbr.Fields(sKolom).Name, dbr.Fields(sKolom).Type)
End With
Next sKolom
db.TableDefs.Delete "Temp Table"
db.TableDefs.Append tbldef
End Sub

Membuat Tabel Access Dengan VBA

Hai Semua...

Baiklah, sekarang kita akan membahas langsung mengenai cara membuat table di Microsoft access dengan menggunakan VBA script.
ini bertujuan agar semua bisa membuat program access dengan mudah tanpa harus manual membuat table dengan menu wizard di access. sehingga jika ada struktur table yang bisa berubah setiap bulan atau tahun, table akan otomatis di buat sesuai dengan yang di inginkan...

dan yang pasti ini harus bermanfaat dan berguna bagi kita semua.

di bab ini kita akan memulai dengan pembuatan table roster yang mana isi table tersebut akan menyesuaikan dengan format kolom bulan sekarang sampai dengan 12 bulan kedepan

Sub CreateTableA()
on error resume next
Dim db As Database
Dim tbldef1 As TableDef
Dim sekarang As Long
Dim nanti As Long
Dim skolom As Long
Dim kolom As String
Dim maxkolom As Long
Set db = CurrentDb()
db.TableDefs.Delete "Table_Roster" & Format(Date, "mmmm yyyy")
Set tbldef1 = db.CreateTableDef("Table_Roster" & Format(Date, "mmmm yyyy"))
With tbldef1
.Fields.Append .CreateField("Nama", dbText)
.Fields.Append .CreateField("Jabatan", dbText)
.Fields.Append .CreateField("Departement", dbText)
.Fields.Append .CreateField("Level", dbText)
.Fields.Append .CreateField("TglMasuk", dbDate)
.Fields.Append .CreateField("TglCuti", dbDate)
End With
sekarang = Format(Date, 0)
nanti = Format(Month(Date)  & "/1/" & Year(Date) + 1, 0)
For skolom = sekarang To nanti
If Format(skolom, "d") = 1 Then
kolom = Format(skolom, "mmm-yy")
With tbldef1
.Fields.Append .CreateField(kolom, dbText)
End With
Next skolom
end if
db.TableDefs.Append tbldef1
End Sub
ok...
Demikian script nya, semoga bermanfaat