home *** CD-ROM | disk | FTP | other *** search
/ Master 95 #1 / MASTER95_1.iso / microsof / vbasic4 / vb4-6.cab / vbimex.bas < prev    next >
Encoding:
BASIC Source File  |  1995-07-26  |  10.6 KB  |  319 lines
  1. Attribute VB_Name = "modIMEXCode"
  2. Option Explicit
  3.  
  4. 'global vars used in the Import Export Code
  5. Global gnDataType As Integer
  6. Global gImpDB As Database
  7. Global gExpDB As Database
  8. Global gExpTable As String
  9.  
  10. 'data types
  11. Global Const gnDT_NONE = -1
  12. Global Const gnDT_JETMDB = 0
  13. Global Const gnDT_DBASEIV = 1
  14. Global Const gnDT_DBASEIII = 2
  15. Global Const gnDT_FOXPRO26 = 3
  16. Global Const gnDT_FOXPRO25 = 4
  17. Global Const gnDT_FOXPRO20 = 5
  18. Global Const gnDT_PARADOX4X = 6
  19. Global Const gnDT_PARADOX3X = 7
  20. Global Const gnDT_BTRIEVE = 8
  21. Global Const gnDT_EXCEL50 = 9
  22. Global Const gnDT_EXCEL40 = 10
  23. Global Const gnDT_EXCEL30 = 11
  24. Global Const gnDT_TEXTFILE = 12
  25. Global Const gnDT_SQLDB = 13
  26.  
  27. Sub Export(rsFromTbl As String, rsToDB As String)
  28.  
  29.   On Error GoTo ExpErr
  30.  
  31.   Dim sConnect As String
  32.   Dim sNewTblName As String
  33.   Dim sDBName As String
  34.   Dim nErrState As Integer
  35.   Dim idxFrom As Index
  36.   Dim idxTo As Index
  37.   Dim sSQL As String              'local copy of sql string
  38.   Dim sField As String
  39.   Dim sFrom As String
  40.   Dim sTmp As String
  41.   Dim i As Integer
  42.  
  43.   If gnDataType = gnDT_SQLDB Then
  44.     Set gExpDB = gwsMainWS.OpenDatabase(gsNULL_STR, 0, 0, "odbc;")
  45.     If gExpDB Is Nothing Then Exit Sub
  46.   End If
  47.  
  48.   MsgBar "Exporting '" & rsFromTbl & "'", True
  49.  
  50.   nErrState = 1
  51.   Select Case gnDataType
  52.     Case gnDT_JETMDB
  53.       sConnect = "[;database=" & rsToDB & "]."
  54.       Set gExpDB = gwsMainWS.OpenDatabase(rsToDB)
  55.     Case gnDT_PARADOX3X
  56.       sDBName = StripFileName(rsToDB)
  57.       sConnect = "[Paradox 3.X;database=" & StripFileName(rsToDB) & "]."
  58.       Set gExpDB = gwsMainWS.OpenDatabase(sDBName, 0, 0, gsPARADOX3X)
  59.     Case gnDT_PARADOX4X
  60.       sDBName = StripFileName(rsToDB)
  61.       sConnect = "[Paradox 4.X;database=" & StripFileName(rsToDB) & "]."
  62.       Set gExpDB = gwsMainWS.OpenDatabase(sDBName, 0, 0, gsPARADOX4X)
  63.     Case gnDT_FOXPRO26
  64.       sDBName = StripFileName(rsToDB)
  65.       sConnect = "[FoxPro 2.6;database=" & StripFileName(rsToDB) & "]."
  66.       Set gExpDB = gwsMainWS.OpenDatabase(sDBName, 0, 0, gsFOXPRO26)
  67.     Case gnDT_FOXPRO25
  68.       sDBName = StripFileName(rsToDB)
  69.       sConnect = "[FoxPro 2.5;database=" & StripFileName(rsToDB) & "]."
  70.       Set gExpDB = gwsMainWS.OpenDatabase(sDBName, 0, 0, gsFOXPRO25)
  71.     Case gnDT_FOXPRO20
  72.       sDBName = StripFileName(rsToDB)
  73.       sConnect = "[FoxPro 2.0;database=" & StripFileName(rsToDB) & "]."
  74.       Set gExpDB = gwsMainWS.OpenDatabase(sDBName, 0, 0, gsFOXPRO20)
  75.     Case gnDT_DBASEIV
  76.       sDBName = StripFileName(rsToDB)
  77.       sConnect = "[dBase IV;database=" & StripFileName(rsToDB) & "]."
  78.       Set gExpDB = gwsMainWS.OpenDatabase(sDBName, 0, 0, gsDBASEIV)
  79.     Case gnDT_DBASEIII
  80.       sDBName = StripFileName(rsToDB)
  81.       sConnect = "[dBase III;database=" & StripFileName(rsToDB) & "]."
  82.       Set gExpDB = gwsMainWS.OpenDatabase(sDBName, 0, 0, gsDBASEIII)
  83.     Case gnDT_BTRIEVE
  84.       sConnect = "[Btrieve;database=" & rsToDB & "]."
  85.       Set gExpDB = gwsMainWS.OpenDatabase(rsToDB, 0, 0, gsBTRIEVE)
  86.     Case gnDT_EXCEL50, gnDT_EXCEL40, gnDT_EXCEL30
  87.       sConnect = "[Excel 5.0;database=" & rsToDB & "]."
  88.       Set gExpDB = gwsMainWS.OpenDatabase(rsToDB, 0, 0, gsEXCEL50)
  89.     Case gnDT_SQLDB
  90.       sConnect = "[" & gExpDB.Connect & "]."
  91.     Case gnDT_TEXTFILE
  92.       sDBName = StripFileName(rsToDB)
  93.       sConnect = "[Text;database=" & StripFileName(rsToDB) & "]."
  94.       Set gExpDB = gwsMainWS.OpenDatabase(sDBName, 0, 0, gsTEXTFILES)
  95.   End Select
  96.   If gnDataType = gnDT_JETMDB Or gnDataType = gnDT_BTRIEVE Or _
  97.      gnDataType = gnDT_SQLDB Or gnDataType = gnDT_EXCEL50 Or _
  98.      gnDataType = gnDT_EXCEL40 Or gnDataType = gnDT_EXCEL30 Then
  99.     With frmExpName
  100.       .Label1.Caption = "Export " & rsFromTbl & " to:"
  101.       .Label2.Caption = "in " & rsToDB
  102.       .txtTable.Text = rsFromTbl
  103.     End With
  104.     frmExpName.Show vbModal
  105.       
  106.     If Len(gExpTable) = 0 Then
  107.       MsgBar gsNULL_STR, False
  108.       Exit Sub
  109.     Else
  110.       sNewTblName = gExpTable
  111.     End If
  112.   Else
  113.     'get the table part of the file name
  114.     'strip off the path
  115.     For i = Len(rsToDB) To 1 Step -1
  116.       If Mid(rsToDB, i, 1) = "\" Then
  117.         Exit For
  118.       End If
  119.     Next
  120.     sTmp = Mid(rsToDB, i + 1, Len(rsToDB))
  121.     'strip off the extension
  122.     For i = 1 To Len(sTmp)
  123.       If Mid(sTmp, i, 1) = "." Then
  124.         Exit For
  125.       End If
  126.     Next
  127.     sNewTblName = Left(sTmp, i - 1)
  128.   End If
  129.   SetHourglass
  130.   If Len(rsFromTbl) > 0 Then
  131.     gdbCurrentDB.Execute "select * into " & sConnect & StripOwner(sNewTblName) & " from " & StripOwner(rsFromTbl)
  132.  
  133.     If gnDataType <> gnDT_TEXTFILE Then
  134.       nErrState = 2
  135.       MsgBar "Creating Indexes for '" & sNewTblName & "'", True
  136.       gExpDB.Tabledefs.Refresh
  137.       For Each idxFrom In gdbCurrentDB.Tabledefs(rsFromTbl).Indexes
  138.         Set idxTo = gExpDB.Tabledefs(sNewTblName).CreateIndex(idxFrom.Name)
  139.         With idxTo
  140.           .Fields = idxFrom.Fields
  141.           .Unique = idxFrom.Unique
  142.           If gnDataType <> gnDT_SQLDB And gsDataType <> "ODBC" Then
  143.             .Primary = idxFrom.Primary
  144.           End If
  145.         End With
  146.         gExpDB.Tabledefs(sNewTblName).Indexes.Append idxTo
  147.       Next
  148.     End If
  149.     MsgBar gsNULL_STR, False
  150.     Screen.MousePointer = vbDefault
  151.     MsgBox "Successfully Exported '" & rsFromTbl & "'.", 64
  152.   Else
  153.     sSQL = frmSQL.txtSQLStatement.Text
  154.     sField = Mid(sSQL, 8, InStr(8, UCase(sSQL), "FROM") - 9)
  155.     sFrom = " " & Mid(sSQL, InStr(UCase(sSQL), "FROM"), Len(sSQL))
  156.     gdbCurrentDB.Execute "select " & sField & " into " & sConnect & sNewTblName & sFrom
  157.  
  158.     Screen.MousePointer = vbDefault
  159.     MsgBar gsNULL_STR, False
  160.     MsgBox "Successfully Exported SQL Statement.", 64
  161.   End If
  162.  
  163.   Exit Sub
  164.  
  165. ExpErr:
  166.   If Err = 3010 Then      'table exists
  167.     If MsgBox("'" & sNewTblName & "' already exists - overwrite?", 32 + 1 + 256) = 1 Then
  168.       gExpDB.Tabledefs.Delete sNewTblName
  169.       Resume
  170.     Else
  171.       Screen.MousePointer = vbDefault
  172.       MsgBar gsNULL_STR, False
  173.       Exit Sub
  174.     End If
  175.   End If
  176.  
  177.   'nuke the new table if the indexes couldn't be created
  178.   If nErrState = 2 Then
  179.     gExpDB.Tabledefs.Delete sNewTblName
  180.   End If
  181.   ShowError
  182.   Exit Sub
  183.  
  184. End Sub
  185.  
  186. Sub Import(rsImpTblName As String)
  187.   On Error GoTo ImpErr
  188.  
  189.   Dim sOldTblName As String, sNewTblName As String, sConnect As String
  190.   Dim idxFrom As Index
  191.   Dim idxTo As Index
  192.   Dim nErrState As Integer
  193.   Dim i As Integer
  194.  
  195.   sOldTblName = MakeTableName(rsImpTblName, False)
  196.   sNewTblName = MakeTableName(rsImpTblName, True)
  197.  
  198.   SetHourglass
  199.   MsgBar "Importing '" & sNewTblName & "'", True
  200.  
  201.   nErrState = 1
  202.   Select Case gnDataType
  203.     Case gnDT_JETMDB
  204.       sConnect = "[;database=" & gImpDB.Name & "]."
  205.     Case gnDT_PARADOX3X
  206.       sConnect = "[Paradox 3.X;database=" & StripFileName(rsImpTblName) & "]."
  207.       Set gImpDB = gwsMainWS.OpenDatabase(StripFileName(rsImpTblName), 0, 0, gsPARADOX3X)
  208.     Case gnDT_PARADOX4X
  209.       sConnect = "[Paradox 4.X;database=" & StripFileName(rsImpTblName) & "]."
  210.       Set gImpDB = gwsMainWS.OpenDatabase(StripFileName(rsImpTblName), 0, 0, gsPARADOX4X)
  211.     Case gnDT_FOXPRO26
  212.       sConnect = "[FoxPro 2.6;database=" & StripFileName(rsImpTblName) & "]."
  213.       Set gImpDB = gwsMainWS.OpenDatabase(StripFileName(rsImpTblName), 0, 0, gsFOXPRO26)
  214.     Case gnDT_FOXPRO25
  215.       sConnect = "[FoxPro 2.5;database=" & StripFileName(rsImpTblName) & "]."
  216.       Set gImpDB = gwsMainWS.OpenDatabase(StripFileName(rsImpTblName), 0, 0, gsFOXPRO25)
  217.     Case gnDT_FOXPRO20
  218.       sConnect = "[FoxPro 2.0;database=" & StripFileName(rsImpTblName) & "]."
  219.       Set gImpDB = gwsMainWS.OpenDatabase(StripFileName(rsImpTblName), 0, 0, gsFOXPRO20)
  220.     Case gnDT_DBASEIV
  221.       sConnect = "[dBase IV;database=" & StripFileName(rsImpTblName) & "]."
  222.       Set gImpDB = gwsMainWS.OpenDatabase(StripFileName(rsImpTblName), 0, 0, gsDBASEIV)
  223.     Case gnDT_DBASEIII
  224.       sConnect = "[dBase III;database=" & StripFileName(rsImpTblName) & "]."
  225.       Set gImpDB = gwsMainWS.OpenDatabase(StripFileName(rsImpTblName), 0, 0, gsDBASEIII)
  226.     Case gnDT_BTRIEVE
  227.       sConnect = "[Btrieve;database=" & gImpDB.Name & "]."
  228.     Case gnDT_EXCEL50, gnDT_EXCEL40, gnDT_EXCEL30
  229.       sConnect = "[Excel 5.0;database=" & gImpDB.Name & "]."
  230.     Case gnDT_SQLDB
  231.       sConnect = "[" & gImpDB.Connect & "]."
  232.     Case gnDT_TEXTFILE
  233.       sConnect = "[Text;database=" & StripFileName(rsImpTblName) & "]."
  234.       Set gImpDB = gwsMainWS.OpenDatabase(StripFileName(rsImpTblName), 0, 0, gsTEXTFILES)
  235.   End Select
  236.   gdbCurrentDB.Execute "select * into " & sNewTblName & " from " & sConnect & sOldTblName
  237.  
  238.   If gnDataType <> gnDT_TEXTFILE And gnDataType <> gnDT_EXCEL50 And _
  239.      gnDataType <> gnDT_EXCEL40 And gnDataType <> gnDT_EXCEL30 Then
  240.     nErrState = 2
  241.     MsgBar gdbCurrentDB.RecordsAffected & " Rows Imported, Creating Indexes for '" & sNewTblName & "'", True
  242.     gdbCurrentDB.Tabledefs.Refresh
  243.     For Each idxFrom In gImpDB.Tabledefs(sOldTblName).Indexes
  244.       Set idxTo = gdbCurrentDB.Tabledefs(sNewTblName).CreateIndex(idxFrom.Name)
  245.       With idxTo
  246.         .Fields = idxFrom.Fields
  247.         .Unique = idxFrom.Unique
  248.         If gnDataType <> gnDT_SQLDB And gsDataType <> gsSQLDB Then
  249.           .Primary = idxFrom.Primary
  250.         End If
  251.       End With
  252.       gdbCurrentDB.Tabledefs(sNewTblName).Indexes.Append idxTo
  253.     Next
  254.   End If
  255.     
  256.   frmImpExp.lstTables.AddItem sNewTblName
  257.   frmTables.lstTables.AddItem sNewTblName
  258.   Screen.MousePointer = vbDefault
  259.   MsgBar gsNULL_STR, False
  260.   MsgBox "Successfully Imported '" & sNewTblName & "'.", 64
  261.  
  262.   Exit Sub
  263.  
  264. NukeNewTbl:
  265.   On Error Resume Next  'just in case it fails
  266.   gdbCurrentDB.Tabledefs.Delete sNewTblName
  267.   ShowError
  268.   Exit Sub
  269.  
  270. ImpErr:
  271.   'nuke the new table if the indexes couldn't be created
  272.   If nErrState = 2 Then
  273.     Resume NukeNewTbl
  274.   End If
  275.   ShowError
  276.   Exit Sub
  277.  
  278. End Sub
  279.  
  280. Function MakeTableName(fname As String, newname As Integer) As String
  281.   On Error Resume Next
  282.   Dim i As Integer, t As Integer
  283.   Dim tmp As String
  284.  
  285.   If gnDataType = gnDT_SQLDB And newname Then
  286.     i = InStr(1, fname, ".")
  287.     If i > 0 Then
  288.       tmp = Mid(fname, 1, i - 1) & "_" & Mid(fname, i + 1, Len(fname))
  289.     End If
  290.   ElseIf InStr(fname, "\") > 0 Then
  291.     'strip off path
  292.     For i = Len(fname) To 1 Step -1
  293.       If Mid(fname, i, 1) = "\" Then
  294.         Exit For
  295.       End If
  296.     Next
  297.     tmp = Mid(fname, i + 1, Len(fname))
  298.     i = InStr(1, tmp, ".")
  299.     If i > 0 Then
  300.       tmp = Mid(tmp, 1, i - 1)
  301.     End If
  302.   Else
  303.     tmp = fname
  304.   End If
  305.  
  306.   If newname Then
  307.     If DupeTableName(tmp) Then
  308.       t = 1
  309.       While DupeTableName(tmp + CStr(t))
  310.         t = t + 1
  311.       Wend
  312.       tmp = tmp + CStr(t)
  313.     End If
  314.   End If
  315.  
  316.   MakeTableName = tmp
  317.  
  318. End Function
  319.