lngsng aja yah ak punya program copy file excel ke access untuk satu
sheet satu table , contoh coding :
Sub AppendRecord()
Dim tbl As New Table
Dim cat As New ADOX.Catalog
Dim cn As New ADODB.Connection
Dim rec As New ADODB.Recordset
Dim fld As ADODB.Field
Dim recNew As New ADODB.Recordset
Dim strExcelPath As String
Dim file_path As String
Dim worksheet1 As String
Dim worksheet2 As String
Dim strSQL As String
Dim intcnt As Long
strExcelPath = file_path & "\\satpsr-np01\bsssystem\" &
Combo1.Text & "\AllBranch\Allbranch.Daily_" & Text1.Text & ".xls"
cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & App.Path & "\Master.MDB"
worksheet1 = "Analysis"
worksheet2 = "AbsoluteValue"
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source= " & strExcelPath & ";Extended Properties=Excel
8.0;" _
& "Persist Security Info=False"
rec.Open "Select * from [" & worksheet1 & "$B4:AO9000]", cn,
adOpenKeyset
tbl.Name = "FileProcess"
For Each fld In rec.Fields
tbl.Columns.Append fld.Name, adChar, 200
Next
recNew.Open "FileProcess", cat.ActiveConnection, adOpenKeyset,
adLockOptimistic
Screen.MousePointer = vbHourglass
ProgressBar1.Visible = True
If rec.RecordCount <> 0 Then
ProgressBar1.Max = rec.RecordCount
End If
intcnt = 1
Do Until rec.EOF
DoEvents
With recNew
.AddNew
.Fields("File_Date") = dtp1.Value
For Each fld In rec.Fields
.Fields(fld.Name) = IIf(IsNull(rec(fld.Name)), "", rec
(fld.Name))
.Fields("Dir_File") = Text1.Text
Next
End With
ProgressBar1.Value = intcnt
lblStatus.Caption = "Transfering " & intcnt & " Records..."
intcnt = intcnt + 1
rec.MoveNext
Loop
DoEvents
MsgBox "Transfer is completed!", 0, "Attention!"
ProgressBar1.Visible = False
lblStatus.Caption = ""
Image1.Visible = True
Exit Sub
End Sub
yg ak tanyakan bagaimana klo copy 2 sheet ke dalam 1 table, atas
perhatian dan bantuannya saya ucapkan terima kasih.
regard's
adie putra
------------------------ Yahoo! Groups Sponsor --------------------~-->
Check out the new improvements in Yahoo! Groups email.
http://us.click.yahoo.com/6pRQfA/fOaOAA/yQLSAA/k7folB/TM
--------------------------------------------------------------------~->
Wahana Programmer Groups Links
<*> Untuk mengunjungi sponsor milis ini, klik link berikut:
http://wahanaprogrammer.net
<*> Untuk menghubungi owner milis ini, kirim email ke:
[EMAIL PROTECTED]
<*> Konsultasi pemrogramman bisa chat disini:
Yahoo! Messenger: wahanaprogrammer
Yahoo! Groups Links
<*> To visit your group on the web, go to:
http://groups.yahoo.com/group/Programmer-VB/
<*> To unsubscribe from this group, send an email to:
[EMAIL PROTECTED]
<*> Your use of Yahoo! Groups is subject to:
http://docs.yahoo.com/info/terms/
