Please help VB app recognize different file formats
Hello all.
I have a database viewer application that I use to generate a report that tells me the numeber of records, name of fields, type of fields, and field character lengths for Microsoft Access Databases. What I need help with is to find a way that my application can recognized other file formats, such as .dbf, .xls, .csv, .txt, etc. How do I go about doing this? Any help I could get on this would be greatly appreciated. And please excuse my inexperience, I am a newbie. Here's my code:
Const frmtitle = "Access Database Mapper"
Const MyFile = 1, fwidth = 5800
Const MaxLines = 67
Dim cst As String, aFile As String, MapFile As String
Dim db As Database
Dim FileCreated As Boolean
Private Sub Check1_Click(Index As Integer)
Mid$(cst, Index + 1) = Check1(Index).Value
Select Case Index
Case 0:
' if user turns off the FieldName, they can't have the
' FieldType or FieldSize either
If Check1(Index).Value = 0 Then
Check1(1).Value = 0
Check1(2).Value = 0
End If
Case 1, 2:
' if user chooses FieldSize or FieldType then
' they MUST need the FieldName too
If (Check1(1).Value = 0) And (Check1(2).Value = 0) Then
Check1(0).Value = 0
Else
Check1(0).Value = 1
End If
End Select
cmdView.Enabled = Val(cst) > 0
End Sub
Sub PrintLine(Aline As String, Optional FontSize As Integer, _
Optional Bold As Boolean)
If Bold Then Printer.FontBold = True
If FontSize > 0 Then Printer.FontSize = FontSize
Printer.Print Aline
ResetPrinterDefaults:
Printer.FontSize = 10
Printer.FontBold = False
End Sub
Sub PrintFooter(NbrLines As Integer, nbrPages As Integer, FileName As String)
Dim i As Integer, x1 As Integer, x2 As Integer
Dim Y As Integer
' locate footer position
With Printer
.CurrentY = .ScaleHeight - 600
Y = .CurrentY
x1 = .CurrentX
x2 = .ScaleWidth
End With
Printer.Line (x1, Y)-(x2, Y)
Printer.Print
Printer.Print FileName; Tab(50); Date; Tab(75); "Page "; nbrPages
End Sub
Private Function IsBold(Aline As String)
Dim Yes As Boolean
Yes = False
Yes = Yes Or InStr(Aline, "Name") = 10
Yes = Yes Or InStr(Aline, "Foreign Table") > 0
IsBold = Yes
End Function
Function GetString(Aline As String) As String
Dim st As String
If InStr(Aline, "Table:") = 1 Then
st = Mid(Aline, 8, Len(Aline))
Else
st = Aline
End If
GetString = st
End Function
Private Function IsHeader(Aline As String)
Dim Yes As Boolean
Yes = False
Yes = InStr(1, Aline, "Table") = 1
Yes = Yes Or InStr(Aline, "FIELDS") = 10
Yes = Yes Or InStr(Aline, "INDEXES") = 1
Yes = Yes Or InStr(Aline, "RELATIONS") = 1
Yes = Yes Or InStr(Aline, "QUERIES") = 1
IsHeader = Yes
End Function
Sub DoNewPageStuff(ByRef NbrLines As Integer, ByRef nbrPages As Integer, _
st As String, tblName As String)
PrintFooter NbrLines, nbrPages, st
Printer.NewPage
NbrLines = 1
nbrPages = nbrPages + 1
If tblName <> "" Then PrintLine tblName & " (cont.)", 10, True
Printer.Print
End Sub
Private Sub PrintData()
Dim st As String, Aline As String, tblName As String
Dim NbrLines As Integer, nbrPages As Integer, i As Integer
Me.MousePointer = vbHourglass
st = Mid$(cdlg1.FileName, 1, Len(cdlg1.FileName) - 4)
st = st & ".map"
NbrLines = 1
nbrPages = 1
Open st For Input As #1
Printer.Font = "Courier"
Printer.FontSize = 10
' Report Header
' the first three lines will always define the database so print them
For i = 0 To 2
Line Input #1, Aline
PrintLine Aline, 14, True
Next i
Do While Not EOF(1)
Line Input #1, Aline
If IsHeader(Aline) Then
If InStr(Aline, "FIELDS") = 0 Then tblName = GetString(Aline)
PrintLine Aline, 12, True
ElseIf IsBold(Aline) Then
PrintLine Aline, 10, True
ElseIf InStr(Aline, "===") > 0 Then
Printer.DrawWidth = 12
Printer.Line (Printer.CurrentX, Printer.CurrentY)-(Printer.ScaleWidth, Printer.CurrentY)
Printer.CurrentY = Printer.CurrentY + 100
Printer.Line (Printer.CurrentX, Printer.CurrentY)-(Printer.ScaleWidth, Printer.CurrentY)
ElseIf ((Aline = "") And (NbrLines >= (MaxLines - 5))) Or NbrLines >= MaxLines Then
DoNewPageStuff NbrLines, nbrPages, st, tblName
PrintLine Aline
Else
PrintLine Aline
End If
NbrLines = NbrLines + 1
' do we need to start a new page anyway
If NbrLines >= MaxLines Then
DoNewPageStuff NbrLines, nbrPages, st, tblName
End If
Loop
Close (1)
Kill st
PrintFooter NbrLines, nbrPages, st
Printer.EndDoc
Label1 = "Done it!!"
Me.Caption = frmtitle
Me.MousePointer = vbDefault
End Sub
Private Sub MapDatabase()
FileCreated = True
'Map the Database properties
Print #MyFile, "DATABASE Name: "; aFile
Print #MyFile, "Connect string: "; db.Connect
Print #MyFile, "Updatable?: "; db.Updatable
Print #MyFile,
Print #MyFile, String$(75, "=")
End Sub
Private Sub MapTableDefs()
'Map the TableDefs
Dim Td As TableDef, fld As Field
List1.Clear
For Each Td In db.TableDefs
If (Td.Attributes And dbSystemObject) = 0 Then _
List1.AddItem Td.Name
Next Td
Label1.Caption = "Select Tables to view"
With List1
If .ListCount < 10 Then
.Height = .ListCount * 330
Else
.Height = 2760
End If
.Visible = True
.SetFocus
End With
End Sub
Sub showheader()
Dim st As String
st = Space$(50)
If Mid(cst, 1, 1) = "1" Then Mid(st, 1) = "Name"
If Mid(cst, 2, 1) = "1" Then Mid(st, 29) = "Type"
If Mid(cst, 3, 1) = "1" Then Mid(st, 45) = "Size"
Print #MyFile, Tab(10); st
st = Space$(50)
If Mid(cst, 1, 1) = "1" Then Mid(st, 1) = "----"
If Mid(cst, 2, 1) = "1" Then Mid(st, 29) = "----"
If Mid(cst, 3, 1) = "1" Then Mid(st, 45) = "----"
Print #MyFile, Tab(10); st
End Sub
Private Sub GetFieldDetails()
Dim i As Integer, st As String
Dim Td As TableDef, fld As Field
For i = 0 To List1.ListCount - 1
If List1.Selected(i) Then
For Each Td In db.TableDefs
If List1.List(i) = Td.Name Then
Print #MyFile,: Print #MyFile,
Print #MyFile, "Table: "; Td.Name
Print #MyFile, Tab(10); "Created: "; Td.DateCreated
Print #MyFile, Tab(10); "Last Used: "; Td.LastUpdated
Print #MyFile, Tab(10); "# Records: "; Td.RecordCount
Print #MyFile,
If Val(cst) > 0 Then
Print #MyFile, Tab(10); "FIELDS"
showheader
For Each fld In Td.Fields
st = Space$(50)
If Mid(cst, 1, 1) = "1" Then Mid(st, 1) = fld.Name
If Mid(cst, 2, 1) = "1" Then Mid(st, 29) = MyLookup(fld.Type)
@)
Print #MyFile, Tab(10); st
Next fld
End If
End If
Next
End If
Next i
Print #MyFile,
Print #MyFile, String$(75, "=")
Print #MyFile,
End Sub
Private Sub MapIndexes()
' Map Indexes for a particular TableDef
Dim idx As Index
Dim Td As TableDef
Dim Arr() As String
Dim i As Integer, n As Integer
Print #MyFile,
Print #MyFile,
Print #MyFile, "INDEXES"
Print #MyFile, Tab(10); "These Fields are indexed. Indexing fields unnecessarily will incurr"
Print #MyFile, Tab(10); "a performance hit during Edit and Add mode as all indexes must be updated."
Print #MyFile,
On Error Resume Next
For Each Td In db.TableDefs
If (Td.Attributes And dbSystemObject) = 0 Then
Print #MyFile, "Table: "; Td.Name
n = 0
For Each idx In Td.Indexes
Set idx = Td.Indexes(n)
Print #MyFile, Tab(10); idx.Fields(0).Name,
If idx.Primary Then
Print #MyFile, "Primary Key"
Else
Print #MyFile,
End If
n = n + 1
Next idx
Print #MyFile,
Print #MyFile,
End If
Next Td
Print #MyFile, String$(75, "=")
Print #MyFile,
End Sub
Sub MapQueries()
Dim qry As QueryDef, fld As Field
Print #MyFile,
Print #MyFile,
Print #MyFile, "QUERIES"
For Each qry In db.QueryDefs
If Left$(qry.Name, 1) <> "~" Then Print #MyFile, Tab(10); qry.Name
Next qry
Print #MyFile,
Print #MyFile, String$(75, "=")
Print #MyFile,
End Sub
Private Sub MapRelations()
Dim Rel As Relation, fld As Field
Print #MyFile,
Print #MyFile,
Print #MyFile, "RELATIONS"
For Each Rel In db.Relations
Print #MyFile, Tab(20); "Table"; Tab(40); "Foreign Table"
Print #MyFile, Tab(20); "-------"; Tab(40); "-------------"
Print #MyFile, Tab(20); Rel.Table; Tab(40); Rel.ForeignTable
' Print #MyFile, "Name:", Rel.Name
' Print #MyFile, "Attributes:", Rel.Attributes
' Map the Fields of the relation
For Each fld In Rel.Fields
Print #MyFile, Tab(5); "Key Fields";
Print #MyFile, Tab(20); fld.Name; Tab(40); fld.ForeignName
Next fld
Print #MyFile,
Print #MyFile,
Next Rel
Print #MyFile, String$(75, "=")
Print #MyFile,
End Sub
Private Function MyLookup(id As Integer)
Dim MyArr(15) As String
MyArr(0) = "-"
MyArr(1) = "Boolean"
MyArr(2) = "Byte"
MyArr(3) = "Integer"
MyArr(4) = "Long"
MyArr(5) = "Currency"
MyArr(6) = "Single"
MyArr(7) = "Double"
MyArr(8) = "Date"
MyArr(9) = "-"
MyArr(10) = "Text"
MyArr(11) = "OLE Object"
MyArr(12) = "Memo"
MyArr(15) = "Replication ID"
MyLookup = MyArr(id)
End Function
Private Sub cmdView_Click()
If cmdView.Caption = "View" Then
Screen.MousePointer = vbHourglass
Open MapFile For Output As #MyFile
MapDatabase
' Do they want Fields, Indexes, Relations or Queries
If Val(Mid$(cst, 1, 3)) > 0 Then GetFieldDetails
If Mid$(cst, 4, 1) = "1" Then MapIndexes
If Mid$(cst, 5, 1) = "1" Then MapRelations
If Mid$(cst, 6, 1) = "1" Then MapQueries
Close MyFile
'now fill the textbox for the User to see it all
Open MapFile For Binary Access Read As #MyFile
Text1 = Input(FileLen(aFile), MyFile)
Close MyFile
List1.Visible = False
Text1.Visible = True
mnuSave.Enabled = True
mnuOpen.Enabled = False
mnuClose.Enabled = True
mnuPrint.Enabled = True
Screen.MousePointer = vbDefault
End If
End Sub
Private Sub cmdQUit_Click()
Unload Me
End Sub
Private Sub Form_Load()
cst = "000000"
FileCreated = False
Label1 = "Select a database to map"
cmdView.Caption = "Map &Selected"
Me.Move 3000, 1500, fwidth, 6000
Frame1.Enabled = False
End Sub
Private Sub Form_Resize()
Text1.Width = Me.ScaleWidth - 200
Text1.Height = Me.ScaleHeight - 200
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
If Not mnuSave.Checked And FileCreated Then Kill (MapFile)
End Sub
Private Sub Label1_Click()
If Label1.Caption = "Select a database to map" Then mnuOpen_Click
End Sub
Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Label1.Caption = "Select a database to map" Then
Label1.ToolTipText = "Select 'File - Open' to open a database"
ElseIf Label1.Caption = "Select Tables to view" Then
Label1.ToolTipText = "Click on 1, or more tables in the box"
End If
End Sub
Private Sub List1_Click()
cmdView.Caption = "View"
Frame1.Enabled = True
End Sub
Private Sub mnuClose_Click()
List1.Visible = True
Text1.Visible = False
mnuClose.Enabled = False
mnuOpen.Enabled = True
mnuPrint.Enabled = False
mnuSave.Enabled = False
cmdView.Caption = "View"
Label1.Caption = "Select Tables to view"
Me.WindowState = vbNormal
Me.Move 3000, 1500, fwidth, 6000
End Sub
Private Sub mnuExit_Click()
Unload Me
End Sub
Private Sub mnuHelp_Click()
frmHelp.Show
End Sub
Private Sub mnuOpen_Click()
cdlg1.Action = 1
On Error GoTo BadFileName
If cdlg1.FileName <> "" Then
aFile = cdlg1.FileName
MapFile = Mid$(cdlg1.FileName, 1, Len(cdlg1.FileName) - 4)
MapFile = MapFile & ".map"
Set db = OpenDatabase(aFile)
' cmdView.Enabled = True
Label1.Caption = "Choose items to Map"
MapTableDefs
Else
GoTo UserCancelled
End If
Exit Sub
BadFileName:
MsgBox Err.Description, , "File Open Error: " & CStr(Err)
UserCancelled:
mnuSave.Enabled = False
mnuPrint.Enabled = False
cmdView.Enabled = False
End Sub
Private Sub mnuPrint_Click()
Me.MousePointer = vbHourglass
Me.Caption = "Printing " & aFile
mnuSave_Click
PrintData
Me.Caption = frmtitle
Me.MousePointer = vbDefault
End Sub
Private Sub mnuSave_Click()
mnuSave.Checked = Not mnuSave.Checked
If mnuSave.Checked Then
Me.MousePointer = vbHourglass
Me.Caption = "Saving " & aFile
Me.Caption = frmtitle
Me.MousePointer = vbDefault
End If
List1.Visible = False
MsgBox "File saved in current directory as " & vbCrLf & aFile
End Sub
I have a database viewer application that I use to generate a report that tells me the numeber of records, name of fields, type of fields, and field character lengths for Microsoft Access Databases. What I need help with is to find a way that my application can recognized other file formats, such as .dbf, .xls, .csv, .txt, etc. How do I go about doing this? Any help I could get on this would be greatly appreciated. And please excuse my inexperience, I am a newbie. Here's my code:
Const frmtitle = "Access Database Mapper"
Const MyFile = 1, fwidth = 5800
Const MaxLines = 67
Dim cst As String, aFile As String, MapFile As String
Dim db As Database
Dim FileCreated As Boolean
Private Sub Check1_Click(Index As Integer)
Mid$(cst, Index + 1) = Check1(Index).Value
Select Case Index
Case 0:
' if user turns off the FieldName, they can't have the
' FieldType or FieldSize either
If Check1(Index).Value = 0 Then
Check1(1).Value = 0
Check1(2).Value = 0
End If
Case 1, 2:
' if user chooses FieldSize or FieldType then
' they MUST need the FieldName too
If (Check1(1).Value = 0) And (Check1(2).Value = 0) Then
Check1(0).Value = 0
Else
Check1(0).Value = 1
End If
End Select
cmdView.Enabled = Val(cst) > 0
End Sub
Sub PrintLine(Aline As String, Optional FontSize As Integer, _
Optional Bold As Boolean)
If Bold Then Printer.FontBold = True
If FontSize > 0 Then Printer.FontSize = FontSize
Printer.Print Aline
ResetPrinterDefaults:
Printer.FontSize = 10
Printer.FontBold = False
End Sub
Sub PrintFooter(NbrLines As Integer, nbrPages As Integer, FileName As String)
Dim i As Integer, x1 As Integer, x2 As Integer
Dim Y As Integer
' locate footer position
With Printer
.CurrentY = .ScaleHeight - 600
Y = .CurrentY
x1 = .CurrentX
x2 = .ScaleWidth
End With
Printer.Line (x1, Y)-(x2, Y)
Printer.Print
Printer.Print FileName; Tab(50); Date; Tab(75); "Page "; nbrPages
End Sub
Private Function IsBold(Aline As String)
Dim Yes As Boolean
Yes = False
Yes = Yes Or InStr(Aline, "Name") = 10
Yes = Yes Or InStr(Aline, "Foreign Table") > 0
IsBold = Yes
End Function
Function GetString(Aline As String) As String
Dim st As String
If InStr(Aline, "Table:") = 1 Then
st = Mid(Aline, 8, Len(Aline))
Else
st = Aline
End If
GetString = st
End Function
Private Function IsHeader(Aline As String)
Dim Yes As Boolean
Yes = False
Yes = InStr(1, Aline, "Table") = 1
Yes = Yes Or InStr(Aline, "FIELDS") = 10
Yes = Yes Or InStr(Aline, "INDEXES") = 1
Yes = Yes Or InStr(Aline, "RELATIONS") = 1
Yes = Yes Or InStr(Aline, "QUERIES") = 1
IsHeader = Yes
End Function
Sub DoNewPageStuff(ByRef NbrLines As Integer, ByRef nbrPages As Integer, _
st As String, tblName As String)
PrintFooter NbrLines, nbrPages, st
Printer.NewPage
NbrLines = 1
nbrPages = nbrPages + 1
If tblName <> "" Then PrintLine tblName & " (cont.)", 10, True
Printer.Print
End Sub
Private Sub PrintData()
Dim st As String, Aline As String, tblName As String
Dim NbrLines As Integer, nbrPages As Integer, i As Integer
Me.MousePointer = vbHourglass
st = Mid$(cdlg1.FileName, 1, Len(cdlg1.FileName) - 4)
st = st & ".map"
NbrLines = 1
nbrPages = 1
Open st For Input As #1
Printer.Font = "Courier"
Printer.FontSize = 10
' Report Header
' the first three lines will always define the database so print them
For i = 0 To 2
Line Input #1, Aline
PrintLine Aline, 14, True
Next i
Do While Not EOF(1)
Line Input #1, Aline
If IsHeader(Aline) Then
If InStr(Aline, "FIELDS") = 0 Then tblName = GetString(Aline)
PrintLine Aline, 12, True
ElseIf IsBold(Aline) Then
PrintLine Aline, 10, True
ElseIf InStr(Aline, "===") > 0 Then
Printer.DrawWidth = 12
Printer.Line (Printer.CurrentX, Printer.CurrentY)-(Printer.ScaleWidth, Printer.CurrentY)
Printer.CurrentY = Printer.CurrentY + 100
Printer.Line (Printer.CurrentX, Printer.CurrentY)-(Printer.ScaleWidth, Printer.CurrentY)
ElseIf ((Aline = "") And (NbrLines >= (MaxLines - 5))) Or NbrLines >= MaxLines Then
DoNewPageStuff NbrLines, nbrPages, st, tblName
PrintLine Aline
Else
PrintLine Aline
End If
NbrLines = NbrLines + 1
' do we need to start a new page anyway
If NbrLines >= MaxLines Then
DoNewPageStuff NbrLines, nbrPages, st, tblName
End If
Loop
Close (1)
Kill st
PrintFooter NbrLines, nbrPages, st
Printer.EndDoc
Label1 = "Done it!!"
Me.Caption = frmtitle
Me.MousePointer = vbDefault
End Sub
Private Sub MapDatabase()
FileCreated = True
'Map the Database properties
Print #MyFile, "DATABASE Name: "; aFile
Print #MyFile, "Connect string: "; db.Connect
Print #MyFile, "Updatable?: "; db.Updatable
Print #MyFile,
Print #MyFile, String$(75, "=")
End Sub
Private Sub MapTableDefs()
'Map the TableDefs
Dim Td As TableDef, fld As Field
List1.Clear
For Each Td In db.TableDefs
If (Td.Attributes And dbSystemObject) = 0 Then _
List1.AddItem Td.Name
Next Td
Label1.Caption = "Select Tables to view"
With List1
If .ListCount < 10 Then
.Height = .ListCount * 330
Else
.Height = 2760
End If
.Visible = True
.SetFocus
End With
End Sub
Sub showheader()
Dim st As String
st = Space$(50)
If Mid(cst, 1, 1) = "1" Then Mid(st, 1) = "Name"
If Mid(cst, 2, 1) = "1" Then Mid(st, 29) = "Type"
If Mid(cst, 3, 1) = "1" Then Mid(st, 45) = "Size"
Print #MyFile, Tab(10); st
st = Space$(50)
If Mid(cst, 1, 1) = "1" Then Mid(st, 1) = "----"
If Mid(cst, 2, 1) = "1" Then Mid(st, 29) = "----"
If Mid(cst, 3, 1) = "1" Then Mid(st, 45) = "----"
Print #MyFile, Tab(10); st
End Sub
Private Sub GetFieldDetails()
Dim i As Integer, st As String
Dim Td As TableDef, fld As Field
For i = 0 To List1.ListCount - 1
If List1.Selected(i) Then
For Each Td In db.TableDefs
If List1.List(i) = Td.Name Then
Print #MyFile,: Print #MyFile,
Print #MyFile, "Table: "; Td.Name
Print #MyFile, Tab(10); "Created: "; Td.DateCreated
Print #MyFile, Tab(10); "Last Used: "; Td.LastUpdated
Print #MyFile, Tab(10); "# Records: "; Td.RecordCount
Print #MyFile,
If Val(cst) > 0 Then
Print #MyFile, Tab(10); "FIELDS"
showheader
For Each fld In Td.Fields
st = Space$(50)
If Mid(cst, 1, 1) = "1" Then Mid(st, 1) = fld.Name
If Mid(cst, 2, 1) = "1" Then Mid(st, 29) = MyLookup(fld.Type)
@)
Print #MyFile, Tab(10); st
Next fld
End If
End If
Next
End If
Next i
Print #MyFile,
Print #MyFile, String$(75, "=")
Print #MyFile,
End Sub
Private Sub MapIndexes()
' Map Indexes for a particular TableDef
Dim idx As Index
Dim Td As TableDef
Dim Arr() As String
Dim i As Integer, n As Integer
Print #MyFile,
Print #MyFile,
Print #MyFile, "INDEXES"
Print #MyFile, Tab(10); "These Fields are indexed. Indexing fields unnecessarily will incurr"
Print #MyFile, Tab(10); "a performance hit during Edit and Add mode as all indexes must be updated."
Print #MyFile,
On Error Resume Next
For Each Td In db.TableDefs
If (Td.Attributes And dbSystemObject) = 0 Then
Print #MyFile, "Table: "; Td.Name
n = 0
For Each idx In Td.Indexes
Set idx = Td.Indexes(n)
Print #MyFile, Tab(10); idx.Fields(0).Name,
If idx.Primary Then
Print #MyFile, "Primary Key"
Else
Print #MyFile,
End If
n = n + 1
Next idx
Print #MyFile,
Print #MyFile,
End If
Next Td
Print #MyFile, String$(75, "=")
Print #MyFile,
End Sub
Sub MapQueries()
Dim qry As QueryDef, fld As Field
Print #MyFile,
Print #MyFile,
Print #MyFile, "QUERIES"
For Each qry In db.QueryDefs
If Left$(qry.Name, 1) <> "~" Then Print #MyFile, Tab(10); qry.Name
Next qry
Print #MyFile,
Print #MyFile, String$(75, "=")
Print #MyFile,
End Sub
Private Sub MapRelations()
Dim Rel As Relation, fld As Field
Print #MyFile,
Print #MyFile,
Print #MyFile, "RELATIONS"
For Each Rel In db.Relations
Print #MyFile, Tab(20); "Table"; Tab(40); "Foreign Table"
Print #MyFile, Tab(20); "-------"; Tab(40); "-------------"
Print #MyFile, Tab(20); Rel.Table; Tab(40); Rel.ForeignTable
' Print #MyFile, "Name:", Rel.Name
' Print #MyFile, "Attributes:", Rel.Attributes
' Map the Fields of the relation
For Each fld In Rel.Fields
Print #MyFile, Tab(5); "Key Fields";
Print #MyFile, Tab(20); fld.Name; Tab(40); fld.ForeignName
Next fld
Print #MyFile,
Print #MyFile,
Next Rel
Print #MyFile, String$(75, "=")
Print #MyFile,
End Sub
Private Function MyLookup(id As Integer)
Dim MyArr(15) As String
MyArr(0) = "-"
MyArr(1) = "Boolean"
MyArr(2) = "Byte"
MyArr(3) = "Integer"
MyArr(4) = "Long"
MyArr(5) = "Currency"
MyArr(6) = "Single"
MyArr(7) = "Double"
MyArr(8) = "Date"
MyArr(9) = "-"
MyArr(10) = "Text"
MyArr(11) = "OLE Object"
MyArr(12) = "Memo"
MyArr(15) = "Replication ID"
MyLookup = MyArr(id)
End Function
Private Sub cmdView_Click()
If cmdView.Caption = "View" Then
Screen.MousePointer = vbHourglass
Open MapFile For Output As #MyFile
MapDatabase
' Do they want Fields, Indexes, Relations or Queries
If Val(Mid$(cst, 1, 3)) > 0 Then GetFieldDetails
If Mid$(cst, 4, 1) = "1" Then MapIndexes
If Mid$(cst, 5, 1) = "1" Then MapRelations
If Mid$(cst, 6, 1) = "1" Then MapQueries
Close MyFile
'now fill the textbox for the User to see it all
Open MapFile For Binary Access Read As #MyFile
Text1 = Input(FileLen(aFile), MyFile)
Close MyFile
List1.Visible = False
Text1.Visible = True
mnuSave.Enabled = True
mnuOpen.Enabled = False
mnuClose.Enabled = True
mnuPrint.Enabled = True
Screen.MousePointer = vbDefault
End If
End Sub
Private Sub cmdQUit_Click()
Unload Me
End Sub
Private Sub Form_Load()
cst = "000000"
FileCreated = False
Label1 = "Select a database to map"
cmdView.Caption = "Map &Selected"
Me.Move 3000, 1500, fwidth, 6000
Frame1.Enabled = False
End Sub
Private Sub Form_Resize()
Text1.Width = Me.ScaleWidth - 200
Text1.Height = Me.ScaleHeight - 200
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
If Not mnuSave.Checked And FileCreated Then Kill (MapFile)
End Sub
Private Sub Label1_Click()
If Label1.Caption = "Select a database to map" Then mnuOpen_Click
End Sub
Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Label1.Caption = "Select a database to map" Then
Label1.ToolTipText = "Select 'File - Open' to open a database"
ElseIf Label1.Caption = "Select Tables to view" Then
Label1.ToolTipText = "Click on 1, or more tables in the box"
End If
End Sub
Private Sub List1_Click()
cmdView.Caption = "View"
Frame1.Enabled = True
End Sub
Private Sub mnuClose_Click()
List1.Visible = True
Text1.Visible = False
mnuClose.Enabled = False
mnuOpen.Enabled = True
mnuPrint.Enabled = False
mnuSave.Enabled = False
cmdView.Caption = "View"
Label1.Caption = "Select Tables to view"
Me.WindowState = vbNormal
Me.Move 3000, 1500, fwidth, 6000
End Sub
Private Sub mnuExit_Click()
Unload Me
End Sub
Private Sub mnuHelp_Click()
frmHelp.Show
End Sub
Private Sub mnuOpen_Click()
cdlg1.Action = 1
On Error GoTo BadFileName
If cdlg1.FileName <> "" Then
aFile = cdlg1.FileName
MapFile = Mid$(cdlg1.FileName, 1, Len(cdlg1.FileName) - 4)
MapFile = MapFile & ".map"
Set db = OpenDatabase(aFile)
' cmdView.Enabled = True
Label1.Caption = "Choose items to Map"
MapTableDefs
Else
GoTo UserCancelled
End If
Exit Sub
BadFileName:
MsgBox Err.Description, , "File Open Error: " & CStr(Err)
UserCancelled:
mnuSave.Enabled = False
mnuPrint.Enabled = False
cmdView.Enabled = False
End Sub
Private Sub mnuPrint_Click()
Me.MousePointer = vbHourglass
Me.Caption = "Printing " & aFile
mnuSave_Click
PrintData
Me.Caption = frmtitle
Me.MousePointer = vbDefault
End Sub
Private Sub mnuSave_Click()
mnuSave.Checked = Not mnuSave.Checked
If mnuSave.Checked Then
Me.MousePointer = vbHourglass
Me.Caption = "Saving " & aFile
Me.Caption = frmtitle
Me.MousePointer = vbDefault
End If
List1.Visible = False
MsgBox "File saved in current directory as " & vbCrLf & aFile
End Sub
Howdy, Stranger!
It looks like you're new here. If you want to get involved, click one of these buttons!
Categories
- 140.8K All Categories
- 103.6K Programming Languages
- 6.4K Assembler Developer
- 401 Assembly Code Share
- 239 Getting started in assembly
- 4.6K x86 Assembly
- 1.9K Basic
- 97 Qbasic
- 39.9K C and C++
- 5.6K Beginner C/C++
- 330 C/C++ on Linux/Unix
- 450 C/C++ Windows API
- 522 C++ Builder
- 253 C++ Game Development
- 3.3K C++ MFC
- 103 C++.NET
- 404 Visual C++
- 2.9K C#
- 7.9K Delphi and Kylix
- 334 Advanced Delphi
- 360 Delphi beginners
- 4 Haskell
- 9.7K Java
- 56 Enterprise JavaBeans
- 1.3K Java Beginners
- 304 Java Server Pages
- 4.1K Pascal
- 1.3K Perl
- 11 Perl 6
- 2K PHP
- 546 Python
- 37 Ruby
- 4.4K VB.NET
- 258 Advanced VB.Net
- 1.6K VBA
- 20.9K Visual Basic
- 767 Access databases and VB
- 831 Advance Visual Basic
- 1.2K Beginner VB
- 2.6K Game programming
- 315 Console programming
- 90 DirectX Game dev
- 1 Minecraft
- 112 Newbie Game Programmers
- 2 Oculus Rift
- 9K Applications
- 1.8K Computer Graphics
- 279 3D Graphics
- 129 DirectX
- 125 OpenGL
- 740 Computer Hardware
- 9 Cooling & Overclocking
- 3.4K Database & SQL
- 1.1K Access
- 91 ADO Programming
- 288 MySQL
- 358 Oracle
- 440 SQL-Server
- 535 Electronics development
- 1.6K Matlab
- 628 Sound & Music
- 25 DirectSound
- 257 XML Development
- 3.3K Classifieds
- 200 Co-operative Projects
- 198 For sale
- 190 FreeLance Software City
- 1.9K Jobs Available
- 603 Jobs Wanted
- 209 Wanted
- 2.9K Microsoft .NET
- 1.8K ASP.NET
- 1.1K .NET General
- 22 .NET WEB-Services
- 129 .NET WinForms
- 14 .NET XML
- 50 ADO.NET
- 144 C# & VB.NET School Support
- 3.4K Miscellaneous
- 4 Join the Team
- 354 Comments on this site
- 69 Computer Emulators
- 2.1K General programming
- 187 New programming languages
- 621 Off topic board
- 200 Mobile & Wireless
- 72 Android
- 126 Palm Pilot
- 338 Multimedia
- 154 Demo programming
- 184 MP3 programming
- 0 Bash scripts
- 27 Cloud Computing
- 1 Witsbits Go Cloud
- 53 FreeBSD
- 1.7K LINUX programming
- 1 Awk scripting
- 332 Linux Support
- 0 Sed scripting
- 370 MS-DOS
- 0 Shell scripting
- 321 Windows CE & Pocket PC
- 4.1K Windows programming
- 177 COM/DCOM
- 61 Networking And Security
- 17 Windows 2003 Server
- 6 Windows Vista
- 176 Windows XP
- 941 Software Development
- 417 Algorithms
- 68 Object Orientation
- 24 RUP & UML
- 92 Project Management
- 95 Quality & Testing
- 268 Security
- 63 Evil Scripting
- 81 Hacking
- 7.7K WEB-Development
- 1.8K Active Server Pages
- 61 AJAX
- 4 Bootstrap Themes
- 55 CGI Development
- 28 ColdFusion
- 224 Flash development
- 1.4K HTML & WEB-Design
- 1.4K Internet Development
- 131 Mobile Internet & Messaging
- 211 Wireless development
- 2.2K JavaScript
- 37 JQuery
- 304 WEB Servers
- 153 Apache
- 79 IIS
- 150 WEB-Services / SOAP
Comments
Basically, you must guess. You set a priority order for file types and assign the type as the first one that matches. For example, all csv files are text files, but not all txt files are csv files so you'd need to see if the file is csv before checking to see if it's text. For many types, the only way to be sure is to completely attempt to parse it. For a text file, it means making sure that none of the bytes fall outside a certain range. For an XML, you'd need to parse according to XML rules. If it fails, assume it's a text file.
There is no 100% method for what you want. The best you can do is get close.