VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmMain
BackColor = &H00C0C0C0&
Caption = "see form_title"
ClientHeight = 5115
ClientLeft = 3690
ClientTop = 3165
ClientWidth = 9120
ForeColor = &H000000FF&
Icon = "FORM1.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
PaletteMode = 1 'UseZOrder
ScaleHeight = 5115
ScaleWidth = 9120
Begin VB.CommandButton cmdListDbTypes
Caption = "List Type Constants"
Height = 255
Left = 5520
TabIndex = 18
Top = 720
Width = 2535
End
Begin VB.CheckBox chkDisplay
Caption = "Display Progressing Data"
Height = 195
Left = 960
TabIndex = 16
Top = 720
Width = 2175
End
Begin VB.CommandButton cmdEnd
Caption = "&End"
Height = 255
Left = 8160
TabIndex = 10
Top = 360
Width = 855
End
Begin VB.CommandButton cmdInterrupt
Caption = "&Interrupt"
Height = 255
Left = 8160
TabIndex = 9
Top = 120
Width = 855
End
Begin VB.CommandButton cmdStartImport
Caption = "Import Database"
Height = 255
Left = 3000
TabIndex = 8
Top = 120
Width = 1455
End
Begin VB.CommandButton cmdStartExport
Caption = "Export Database"
Height = 255
Left = 120
TabIndex = 7
Top = 120
Width = 1695
End
Begin VB.CommandButton cmdImportTo
Caption = "..."
Height = 255
Left = 7800
TabIndex = 6
Top = 360
Width = 255
End
Begin VB.TextBox txtImportTo
Height = 285
Left = 5520
TabIndex = 5
Top = 360
Width = 2295
End
Begin VB.CommandButton cmdSelectToExport
Caption = "..."
Height = 255
Left = 4800
TabIndex = 4
Top = 360
Width = 255
End
Begin VB.TextBox txtExportTo
Height = 285
Left = 3000
TabIndex = 3
Top = 360
Width = 1815
End
Begin VB.CommandButton cmdSelectToOpen
Caption = "..."
Height = 255
Left = 2160
TabIndex = 2
Top = 360
Width = 255
End
Begin VB.TextBox txtOpenDatabase
Height = 285
Left = 120
TabIndex = 1
Top = 360
Width = 2055
End
Begin VB.TextBox txtConsole
BackColor = &H00FFFFFF&
Height = 4095
Left = 120
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 0
Top = 960
Width = 8895
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 7920
Top = -120
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.Label lblProgress
Alignment = 1 'Right Justify
Height = 255
Left = 3240
TabIndex = 17
Top = 720
Width = 1935
End
Begin VB.Label Label4
Caption = "from:"
Height = 255
Left = 4560
TabIndex = 15
Top = 120
Width = 495
End
Begin VB.Label Label3
Caption = "from:"
Height = 255
Left = 1920
TabIndex = 14
Top = 120
Width = 495
End
Begin VB.Label Label2
Caption = "to:"
Height = 255
Left = 5160
TabIndex = 13
Top = 360
Width = 375
End
Begin VB.Label Label1
Caption = "to:"
Height = 255
Left = 2640
TabIndex = 12
Top = 360
Width = 375
End
Begin VB.Label lbllResult
Caption = "Imported Database Name:"
Height = 255
Left = 5640
TabIndex = 11
Top = 120
Width = 1935
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public console As Object
Private ReferenceText$
Dim form_title$
Const ExceptionColor& = &HFF&
Const OpenColor& = &H404080
Const NotOpenColor& = &HC0C0C0
Sub p_lsl(s$)
rcon vbCrLf & s & vbCrLf
End Sub
Sub p_s(s$)
rcon s
End Sub
Sub p_sl(s$)
rcon s & vbCrLf
End Sub
Function OpenDB$()
On Error GoTo he
rl "opening database " & ImportFromDatabaseName
If Dir(ImportFromDatabaseName) = "" Then
rl "this file is not found; cannot open database;"
Exit Function
End If
If DBOpen Then
rl "db was open; closing ..."
CloseDB
End If
Set MyWs = DBEngine.Workspaces(0)
Set MyDB = MyWs.OpenDatabase(ImportFromDatabaseName)
DBOpen = True
frmMain.Caption = form_title & " " & _
get_short_name(ImportFromDatabaseName)
'If frmMain.BackColor <> ExceptionColor Then _
' frmMain.BackColor = OpenColor
rl "database open"
Exit Function
he: OpenDB = "Exception opening database " & _
ImportFromDatabaseName & vbCrLf & _
Err.Number & " " & Err.Description
End Function
Sub rcon(s$)
Dim handle%, FName$
With txtConsole
If Len(.Text) > 20000 Then
On Error GoTo FOperations
FName = App.Path & "\console.txt"
handle = FreeFile
Open App.Path & "\console.txt" For Append As handle
Print #handle, , .Text
Close handle
.Text = "console refreshed ... " & vbCrLf
On Error GoTo 0
End If
.SelStart = Len(.Text)
.SelLength = 1
.SelText = s
End With
Exit Sub
FOperations: MsgBox "Exception " & Err.Number & " " & _
Err.Description & vbCrLf & _
"File name " & FName
End Sub
Public Sub rl(s$)
rline (s)
End Sub
Sub rline(s$)
rcon s & vbCrLf
End Sub
Private Sub chkDisplay_Click()
DisplayImportedData = IIf(1 = chkDisplay.Value, True, False)
End Sub
Private Sub cmdEnd_Click()
CloseDB
End
End Sub
Private Sub cmdImportTo_Click()
Dim xcep$
txtImportTo.Text = _
SelectFileForOpening( _
txtImportTo.Text, "MSAccess (*.mdb)|*.mdb" & _
"|All Files (*.*)|*.*", CommonDialog1, xcep, _
"Select Result Name for Import of Database.")
If "" <> xcep Then
MsgBox xcep
Exit Sub
End If
End Sub
Private Sub cmdInterrupt_Click()
Interrupted = "Y"
End Sub
Private Sub cmdListDbTypes_Click()
rl ListDbTypes
End Sub
Private Sub cmdSelectToExport_Click()
Dim xcep$
txtExportTo.Text = _
SelectFileForOpening( _
txtExportTo.Text, "Text Files (*.txt)|*.txt" & _
"|All Files (*.*)|*.*", CommonDialog1, xcep, _
"Select Name for Text-Database.")
If "" <> xcep Then
MsgBox xcep
Exit Sub
End If
End Sub
Private Sub cmdSelectToOpen_Click()
Dim xcep$
txtOpenDatabase.Text = _
SelectFileForOpening( _
txtOpenDatabase.Text, "MSAccess (*.mdb)|*.mdb" & _
"|All Files (*.*)|*.*", CommonDialog1, xcep, _
"Select Source Database Name.")
If "" <> xcep Then
MsgBox xcep
Exit Sub
End If
End Sub
Private Sub cmdStartExport_Click()
ImportFromDatabaseName = Trim(txtOpenDatabase.Text)
If "" = ImportFromDatabaseName Then
cmdSelectToOpen_Click
Exit Sub
ElseIf InStr(ImportFromDatabaseName, ":") = 0 Then
cmdSelectToOpen_Click
Exit Sub
End If
Again2:
ExportDb = Trim(txtExportTo.Text)
If "" = ExportDb Then
cmdSelectToExport_Click
Exit Sub
ElseIf InStr(ExportDb, ":") = 0 Then
cmdSelectToExport_Click
Exit Sub
End If
'If Not LCase(Right(ImportFromDatabaseName, 4)) = ".mdb" Then
' ImportFromDatabaseName = ImportFromDatabaseName & ".mdb"
'End If
OpenDB
ExportDatabase
CloseDB
End Sub
Private Sub cmdStartImport_Click()
Dim ImportToDatabaseName$
'txtExportTo.Text = "C:\d\AccessImport\t.txt"
ImportFileName = Trim(txtExportTo.Text)
If "" = ImportFileName Then
cmdSelectToExport_Click
Exit Sub
ElseIf InStr(ImportFileName, ":") = 0 Then
cmdSelectToExport_Click
Exit Sub
End If
'txtImportTo.Text = "C:\d\AccessImport\d.mdb"
ImportToDatabaseName = Trim(txtImportTo.Text)
If "" = ImportToDatabaseName Then
cmdImportTo_Click
Exit Sub
ElseIf InStr(ImportToDatabaseName, ":") = 0 Then
cmdImportTo_Click
Exit Sub
End If
If "" <> OpenImportFile Then Exit Sub
ImportDatabase ImportToDatabaseName
If DBForImportIsOpen Then nDB.Close
End Sub
Private Sub Form_Load()
DP = False
form_title = "Convert Access Database To and From Text"
frmMain.Caption = form_title
Set console = txtConsole
DBOpen = False
ChDir App.Path
DisplayImportedData = IIf(1 = chkDisplay.Value, True, False)
Exit Sub
End Sub
Private Sub Form_Resize()
Dim w&, h&
h = frmMain.Height - txtConsole.Top - 600
If h > 200 Then txtConsole.Height = h
w = frmMain.Width - 400
If w > 200 Then txtConsole.Width = w
End Sub
Private Sub Form_Unload(Cancel As Integer)
CloseDB
End Sub