SOURCE CODECLIENT.doc

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
tname = frmtm.tvtable.SelectedItem.Text
Else
tname = getfiletitle(fname)
End If
'Lay duong dan
pa = getpath(fname)
Select Case daty

Case "access"
sconnect = "[;database=" & fname & "]." & "[" & tname & "]"
'Mo db de lay constraint
reopen:
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;")

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

End Select
pa = frmtm.tvtable.SelectedItem.Text
frmtm.dbs.Execute "Select * Into " & sconnect & " From " & "[" & pa &
"]"
frmtm.dbs.TableDefs.Refresh
'Export constraint
On Error GoTo xoa
If daty <> "text" Then
For Each idx In frmtm.dbs.TableDefs(pa).Indexes
Set idxnew = dbs.TableDefs(tname).CreateIndex(idx.name)
With idxnew
.Fields = idx.Fields
.Unique = idx.Unique
.Primary = idx.Primary
.IgnoreNulls = idx.IgnoreNulls
.Required = idx.Required
End With
dbs.TableDefs(tname).Indexes.Append idxnew
Next
End If
Set idx = Nothing
Set idxnew = Nothing
Set dbs = Nothing
showstatus "Ready", False
MsgBox "Export successfull", vbInformation, "Successfull"
frmtm.tvtable.SetFocus
Exit Sub

xoa:
MsgBox "Can't create constraint", vbInformation, "Export not complete"
frmtm.tvtable.SetFocus
showstatus "Ready", False
Exit Sub

loi:

If Err.Number = 3031 Then
showstatus "Password require", True
frmpassword.Show vbModal
ppw = frmpassword.pw
Unload frmpassword
If ppw <> "" Then
Resume reopen
End If
End If
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
Dim sconnect As String
Dim dbs As Database
Dim idx As Index
Dim idxnew As Index
showstatus "Trying import", True

'Lay ten file
tname = getfiletitle(fname)
'Lay duong dan
pa = getpath(fname)

Select Case dtype
Case "access"
sconnect = "[;database=" & frmimport.dbs.name & "]." & "[" &
fname & "]"
Set dbs = frmimport.dbs
tname = fname
Case "foxpro"
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 & "]"