SOURCE CODECLIENT.doc

13 551 0
SOURCE CODECLIENT.doc

Đang tải... (xem toàn văn)

Tài liệu hạn chế xem trước, để xem đầy đủ mời bạn chọn Tải xuống

Thông tin tài liệu

SOURCE CODECLIENT

Trang 1

Source CodeClient

Sub export(fname As String, daty As String) On Error GoTo loi

Dim sconnect As String Dim tname As String Dim pa As String Dim idx As Index Dim idxnew As Index Dim dbs As Database Dim ppw As String

showstatus "Trying export ", True 'Ten cua table export

If daty = "access" Then

Trang 2

Case "access"

sconnect = "[;database=" & fname & "]." & "[" & tname & "]" 'Mo db de lay constraint

Set dbs = OpenDatabase(fname, 0, 0, ";pwd=" & ppw)

Case "foxpro"

sconnect = "[FoxPro 2.6;database=" & pa & "]." & "[" & tname & "]" Set dbs = OpenDatabase(pa, 0, 0, "FoxPro 2.6;")

On Error GoTo xoa If daty <> "text" Then

For Each idx In frmtm.dbs.TableDefs(pa).Indexes

Trang 3

Set idxnew = dbs.TableDefs(tname).CreateIndex(idx.name)

Set idx = Nothing Set idxnew = Nothing Set dbs = Nothing

showstatus "Ready", False

MsgBox "Export successfull", vbInformation, "Successfull"

Trang 4

showstatus "Ready", False

MsgBox "Can't export this table", vbInformation, "Export fail" frmtm.tvtable.SetFocus

End Sub

Sub import(fname As String, dtype As String) On Error GoTo loi

Dim tname As String Dim pa As String

Trang 5

Dim sconnect As String Dim dbs As Database Dim idx As Index Dim idxnew As Index

showstatus "Trying import", True 'Lay ten file

sconnect = "[FoxPro 2.6;database=" & pa & "]." & "[" & tname & "]" 'Mo db de lay cac constraint

Set dbs = OpenDatabase(pa, 0, 0, "FoxPro 2.6;")

Case "text"

sconnect = "[Text;database=" & pa & "]." & "[" & tname & "]"

Trang 6

On Error GoTo xoa

If dtype <> "text" Then

For Each idx In dbs.TableDefs(tname).Indexes

Set idxnew = frmtm.dbs.TableDefs(tname).CreateIndex(idx.name)

Trang 7

Set dbs = Nothing Set idx = Nothing Set idxnew = Nothing showstatus "Ready", False

MsgBox "Can't create constraint", vbInformation, "Import fail"

Trang 8

MsgBox "The table make sure at least one field", vbInformation, "Import fail"

Exit Sub End If

showstatus "Ready", False

MsgBox "Can't import this table", vbInformation, "Import fail" End Sub

Public Function getfiletitle(s As String) As String

'lay ten file, cat bo duong dan, bo phan mo rong (.***) vd:abc On Error Resume Next

getfiletitle = Mid$(s, i + 1, Len(s) - i - 4) 'file khong co phan mo rong

Else

getfiletitle = Mid$(s, i + 1, Len(s) - i) End If

Trang 9

On Error GoTo loi

'Chon kieu du lieu import

Trang 10

frmimport.lbtitle.Caption = frmimport.lbtitle.Caption &

Trang 11

Dim bol As Boolean Dim st As String

Dim accessdb As Database Dim inf As String

On Error GoTo loi

cmdlg.InitDir = "c:\program files\Microsoft Visual Studio\vb98\" cmdlg.Filter = "Database File (*.mdb)|*.mdb"

cmdlg.CancelError = True cmdlg.ShowOpen

showstatus "Openning database ", True 'Flags = 1024 : binh thuong, 1025 :Read Only

If (cmdlg.Flags And FileOpenConstants.cdlOFNReadOnly) =

Ngày đăng: 25/08/2012, 10:24

Từ khóa liên quan

Tài liệu cùng người dùng

  • Đang cập nhật ...

Tài liệu liên quan