Option Explicit
Private conn As ADODB.Connection
Dim Dbpath As String
Private Sub Load_list()
Dim itemX As ListItem
Dim sitem As ListSubItem
Dim rs As ADODB.Recordset
Dim i As Integer
'Dim choosen As String
Dim intCounter As Integer ' Counter to set Progressbar.Value
'Create New connection
'choosen = OpenSchemaX()
ListView1.ListItems.Clear
ListView1.ColumnHeaders.Clear
Set rs = New ADODB.Recordset
rs.Open Combo1.List(Combo1.ListIndex), conn, adOpenKeyset, adLockPessimistic
With prgLoad
.Max = rs.RecordCount
.Visible = True
End With
ListView1.View = lvwReport
Dim w As Integer ' add this line
w = 0
For i = 1 To rs.Fields.Count
ListView1.ColumnHeaders.Add , , rs.Fields(w).Name
w = w + 1
Next i
Dim y As Integer
y = 0
Dim q As Integer
Do Until rs.EOF
intCounter = intCounter + 1 'Increase counter for ProgressBar
prgLoad.Value = intCounter ' Update ProgressBar.
Set itemX = ListView1.ListItems.Add(, , rs.Fields(0), , 1)
'itemX.SmallIcon = 1
'itemX.EnsureVisible = True
For q = 1 To rs.Fields.Count - 1 '
If IsNull(rs.Fields(q)) Then
Set sitem = itemX.ListSubItems.Add(, , "")
Else
Set sitem = itemX.ListSubItems.Add(, , rs.Fields(q))
End If
'ListView1 Items cannot contain a null value
'Check if NULL
'If Null add a a zero length string ""
Set sitem = Nothing
Next
Set itemX = Nothing
rs.MoveNext
' DoEvents
Loop
With sbrData
.Panels(1).Text = "Total Record Count: " & rs.RecordCount
.Panels(1).AutoSize = sbrContents
End With
' Hide Progressbar
prgLoad.Visible = False
'Close the RecordSet
rs.Close
'Close the Connection
'conn.Close
Set rs = Nothing
'Set conn = Nothing
End Sub
Private Sub Combo1_Change()
Call Load_list
End Sub
Private Sub Combo1_Click()
Call Load_list
End Sub
Private Sub Form_Load()
Call ShowProgressInStatusBar(True)
End Sub
Private Sub Form_Unload(Cancel As Integer)
UnloadAllForms
End Sub
Private Sub mnu0pen_Click()
Call OpenFile
End Sub
Private Sub mnuAbout_Click()
frmAbout.Show 'Show the About Form
End Sub
Private Sub mnuExit_Click()
UnloadAllForms
End Sub
Public Sub UnloadAllForms()
conn.Close
Set conn = Nothing
Dim Form As Form
For Each Form In Forms
Unload Form
Set Form = Nothing
Next Form
End Sub
Private Function OpenFile() As String
On Error GoTo ErrHandler
With CommonDialog1
.CancelError = True
.Filter = "(*.MDB)|*.mdb"
.FilterIndex = 1
.InitDir = CurDir
.Action = 1
End With
Dbpath = CommonDialog1.FileName
Call Connect
ErrHandler:
If Err.Number = cdlCancel Then
' User pressed Cancel button.
MsgBox "Please choose a Table", vbDefaultButton1, "Error:"
End If
End Function
Private Sub ShowProgressInStatusBar(ByVal bShowProgressBar As Boolean)
Dim tRC As RECT
If bShowProgressBar Then
'
' Get the size of the Panel (2) Rectangle from the status bar
' remember that Indexes in the API are always 0 based (well,
' nearly always) - therefore Panel(2) = Panel(1) to the api
'
'
SendMessageAny sbrData.hwnd, SB_GETRECT, 1, tRC
'
' and convert it to twips....
'
With tRC
.Top = (.Top * Screen.TwipsPerPixelY)
.Left = (.Left * Screen.TwipsPerPixelX)
.Bottom = (.Bottom * Screen.TwipsPerPixelY) - .Top
.Right = (.Right * Screen.TwipsPerPixelX) - .Left
End With
'
' Now Reparent the ProgressBar to the statusbar
'
With prgLoad
SetParent .hwnd, sbrData.hwnd
.Move tRC.Left, tRC.Top, tRC.Right, tRC.Bottom
.Visible = True
.Value = 0
End With
Else
'
' Reparent the progress bar back to the form and hide it
'
SetParent prgLoad.hwnd, Me.hwnd
prgLoad.Visible = False
End If
End Sub
Private Sub OpenSchemaX()
Dim rs1 As ADODB.Recordset
Set rs1 = conn.OpenSchema(adSchemaTables)
Do Until rs1.EOF
Combo1.AddItem (rs1!TABLE_NAME)
rs1.MoveNext
Loop
rs1.Close
MsgBox "Please choose a table from the dropdown box.", vbInformation, "Choose a table"
End Sub
Private Sub Connect()
Dim rs As ADODB.Recordset
If Dbpath <> "" Then
Set conn = New ADODB.Connection
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Dbpath
Call OpenSchemaX
Else
MsgBox "You must choose a Database to open.", vbExclamation, "Error"
Call OpenFile
End If
End Sub
Private Sub Form_Resize()
ListView1.Height = ScaleHeight - Frame1.Height - sbrData.Height
ListView1.Width = ScaleWidth
ListView1.Top = Frame1.Top + Frame1.Height
Dim ColHead As ColumnHeader
Dim ColWidth As Long
Dim ColCoef As Single
'** Resize Column Headers
For Each ColHead In ListView1.ColumnHeaders
ColWidth = ColWidth + ColHead.Width
Next
ColCoef = (ListView1.Width - ColWidth - 90) / ListView1.ColumnHeaders.Count
For Each ColHead In ListView1.ColumnHeaders
ColHead.Width = ColHead.Width + ColCoef
Next
Call ShowProgressInStatusBar(True)
End Sub
Your code to resize a ListView worked very well. Thank you. I have another resize question for you though. I have several text boxes and labels inside of a frame. How can I resize the frame along with all of the text boxes and labels in it? Thanks for any help.
Your code to resize a ListView worked very well. Thank you. I have another resize question for you though. I have several text boxes and labels inside of a frame. How can I resize the frame along with all of the text boxes and labels in it? Thanks for any help.
Reply With Quote
