ACCESS FEED: [belajar-access] Access Loop

Kamis, 23 Mei 2013

[belajar-access] Access Loop

Dear Agan2, ada yang bisa bantu gak?
Dengan menggunakan script di bawah masih lumayan lambat. jumlah row 50.000, dan untuk membuat proyeksi kost selama 5 tahun kedepan jadi semakin lambat...
ada solusi?

Sub Projection_Cost_A()
On Error Resume Next

'SET PRIORITY TO ABOVE NORMAL
Const ABOVE_NORMAL = 32768
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcesses = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = 'MSACCESS.exe'")
For Each objProcess In colProcesses
objProcess.SetPriority (ABOVE_NORMAL)
Next

Dim awal As Long
Dim sekarang As Long
Dim selesai As Long
Dim scan As Long
Dim maxkolom As Long
Dim kolom As String

Dim fR As Long
Dim fC As Long
Dim fScan As Long

'Array Component
Dim tblarr1 As Variant
Dim tblarr2 As Variant
Dim Rw As Long
Dim Cl As Long
Dim ArrScan As Long

'Database Component
Dim db As Database
Dim actcost As Recordset
Dim fequipment As Recordset
Dim pcost As Recordset
Dim Maxdate As Recordset
Dim qrydef1 As QueryDef
Dim qrydef2 As QueryDef
Dim tbldef1 As TableDef
Dim mysql As String

finddatabase 'Mencari Database Location

Set db = CurrentDb()
Set Maxdate = db.OpenRecordset("Select MAX(dbo_asset_master.[disposal date]) as [Disposal Date] from dbo_Asset_Master")
Set fequipment = db.OpenRecordset("Select dbo_Asset_Master.[Group], dbo_Asset_Master.[Machine_Model], dbo_equipment_forecast.* from dbo_equipment_forecast INNER JOIN dbo_asset_master on dbo_equipment_forecast.[assetid] = dbo_asset_master.[assetid] Where dbo_asset_master.[group]='" & Form_f_forecast_dialog3.Group & "'")

db.TableDefs.delete "dbo_projection_cost" 'Delete Table Sebelumnya...
Set tbldef1 = db.CreateTableDef("dbo_projection_cost")

'Membuat fields table sesuai dengan table equipment forecast
For fScan = 0 To fequipment.Fields.Count
With tbldef1
.Fields.Append .CreateField(UCase(fequipment.Fields(fScan).Name), fequipment.Fields(fScan).Type)
End With
Next fScan
'Membuat fields sesuai dengan bulan hingga 5 tahun
awal = Format("1/1/" & Year(Date), 0)
sekarang = Format(Date, 0)
selesai = Format(Maxdate![Disposal Date], 0)
maxkolom = 0
For scan = awal To selesai
If Format(scan, "d") = 1 Then
maxkolom = maxkolom + 1
If maxkolom <= 60 Then
kolom = Format(scan, "mmm-yy")
With tbldef1
.Fields.Append .CreateField(UCase(kolom), dbCurrency)
.Fields(kolom).DefaultValue = 0
End With
End If
End If
Next scan
db.TableDefs.Append tbldef1

fequipment.MoveLast
fequipment.MoveFirst
tblarr1 = fequipment.GetRows(fequipment.RecordCount) 'Load Data to array table

Set pcost = db.OpenRecordset("Select * from dbo_Projection_Cost")
'Looping
DoCmd.OpenForm "f_progress"
For Rw = 0 To UBound(tblarr1, 2)
pcost.AddNew
For Cl = 0 To UBound(tblarr1, 1)
With Form_f_progress
.Caption = "Update Record " & Rw & " of " & UBound(tblarr1, 2)
.l_bar.Width = (Rw / UBound(tblarr1, 2)) * .L_Process
.L_Process.Visible = False
.l_judul.Visible = False
End With
pcost.Fields(Cl).Value = UCase(tblarr1(Cl, Rw))
Next Cl
pcost.Update
pcost.MoveNext
Next Rw
DoCmd.Close acForm, "f_Progress"
pcost.MoveLast
pcost.MoveFirst
tblarr2 = pcost.GetRows(pcost.RecordCount) 'Load data projection cost

'Calculate projection...
Dim sFreq As Long
Dim WH As Long
Dim kelipatan As Long
Dim ScanFreq As Long
Dim MaxChange As Date
Dim SInterval As Long

fequipment.Close
Maxdate.Close
db.Close
End Sub