Index of topics on this page


VB.NET


PROBLEM - Visual Basic .Net Specified cast is not valid

PROBLEM - You do not have a license to use this ActiveX control (VB.NET) specifically convert from vb5 to vb.net

PROBLEM - WORD Mail merge fails on VISTA OS - Run time error '5922' Word was unable to open datasource

PROBLEM - Error "Unrecognized Database Format" When You Upgrade to Access 2000 or 2002 VB.NET

FORM - Start a new form from base form in VB.NET

FORM - Determining screen coordinates in VB.NET

FORM - Setting control color in VB.NET

FORM / TAB CONTROL - Tab control event in VB.NET

FORM / LISTVIEW - Using the listview control in VB.NET

FORM / LISTVIEW - Using mousemove for the LISTVIEW control VB.NET

FORM - Build dynamic control indexed arrays in VB.NET

FORM - Trapping keypress events within VB.NET

FORM - Trapping mouse wheel events within VB.NET

FORM / DRAWING - Build your own pie or bar chart using VB.NET - get rid of MSChart activex!

FORM / INET - Replace old vb Inet activex with .net internet download capability

FORM / TIMER - Using VB.NET timer control

DISTRIBUTION - Distributing .exe software using VB.NET

DISTRIBUTION - Build reusable dll component using VB.NET standard

MISC - Structures and arraylist in VB.NET are great tools to use!

MISC - Using Dim global public static variables

MISC - Simple sleep delay event in VB.NET

MISC - Writing to the Framework event application log in VB.NET

MISC - Create hexadecimal date serial numbers

MISC - Determine system directory with and without windows api with vb4, vb5 vb6 and VB.NET

MISC - Load an icon or bitmap to set as a picturebox image at run time using embedded resources

MISC - Convert arraylist content to XML for storing and then loading it back in to an arraylist

MISC - Simple bubble sort

MISC - Running multiple threads from one vb.net application - ThreadPool.QueueUserWorkItem

MISC - using date time string format in VB.NET

BROWSER - Start default web browser from your Visual Basic or VB.NET program

DATABASE - Reading MS ACCESS schema including tables, columns and foreign keys in VB.NET by using OleDbSchemaGuid

ERROR HANDLING - Error handling in VB.NET


OLD VISUAL BASIC....
Using Visual Basic and Word merge features
Using "If" statements within Word documents
Determining operating system in Visual Basic
Limiting the number of running instances of your app
Compressing and uncompressing data - Quick Basic days













Word merge and Visual basic 5.0
Top

VB interface with MS word utilizing merge features

For help on building a MS word document with merged data click here for my instructions


' please note - I do not know how to do this with vb.net (not yet)
'
' these are in the same module as the "StartWordApp" subroutine
'
Dim oApp As Word.Application
Dim oDoc As Word.Document

Public Sub StartWordApp(ProgramPath As String, MergePath As String, EditOnly As Boolean, DeliveryType As String)
' see if already running
'
' SYSRUNDISK is a global variable that holds the disk drive program is running
' ProgramPath is the location of the word document
' MergePath is the location of the merge text file
' EditOnly is true or false; if true document is opened for updating
' DeliveryType is Email, Fax or document to merge/view
' SYSCYCLESELECTED is a global string passed from a screen selected
'
If TypeName(oApp) <> "Application" Then
   Set oApp = CreateObject("Word.Application")
End If
Dim FullProgramPath As String, FullMergePath As String
If Mid(ProgramPath, 2, 1) <> ":" Then
   FullProgramPath = SYSRUNDISK & ProgramPath
  Else
   FullProgramPath = ProgramPath
End If

If Mid(FullMergePath, 2, 1) <> ":" And MergePath <> "" Then
   FullMergePath = SYSRUNDISK & MergePath
  Else
   FullMergePath = MergePath
End If

If EditOnly = True Then
     ' open word doc for edit/change if editonly=true
     Set oDoc = oApp.Documents.Add(FullProgramPath)
     If Len(FullMergePath) Then
        oDoc.MailMerge.OpenDataSource Name:=FullMergePath
        oDoc.MailMerge.EditMainDocument
     End If
     oDoc.SaveAs (FullProgramPath)
     oApp.WindowState = wdWindowStateNormal
'     oApp.WindowState = wdWindowStateMaximize - causes menu to be disabled
     oApp.Visible = True

    Exit Sub
End If
    
Set oDoc = oApp.Documents.Add(FullProgramPath)
With oDoc.MailMerge
'Set up the mail merge type as mailing labels and use
'a tab-delimited text file as the data source.
    .MainDocumentType = wdFormLetters
    .OpenDataSource Name:=FullMergePath
    If DeliveryType = "Email" Then
        .Destination = wdSendToEmail
        .MailAddressFieldName = "Email_address" 'matches a word merge defined field
        .MailAsAttachment = True
        .MailSubject = SYSCYCLESELECTED
    ElseIf DeliveryType = "Fax" Then
        .Destination = wdSendToFax
        .MailAddressFieldName = "Fax_phone_number"
    Else
        .Destination = wdSendToNewDocument
    End If
    .Execute

End With
            
'Prevent save to Normal template when user exits Word
'oApp.NormalTemplate.Saved = True
             
'Close the original document and make Word visible so that
'the mail merge results are displayed
oDoc.Close False
If DeliveryType = "Email" Then
    oApp.Quit
Else
    oApp.Visible = True
End If
             
' Set oApp = Nothing
End Sub


Microsoft Word

IF statement
Top

{ IF {MERGEFIELD Tax_applied} = "" " " "Taxes applied" \* MERGEFORMAT}
The result of the statement above results if there are taxes, otherwise this IF statement prints a blank:
Taxes applied 100.00
If there is no value in the Tax_applied field (is 100.00) then "Taxes applied" does not print


Visual Basic 5.0

Determining operating system
Top

Public Declare Function GetVersionExA Lib "kernel32" _
               (lpVersionInformation As OSVERSIONINFO) As Integer
 
            Public Type OSVERSIONINFO
               dwOSVersionInfoSize As Long
               dwMajorVersion As Long
               dwMinorVersion As Long
               dwBuildNumber As Long
               dwPlatformId As Long
               szCSDVersion As String * 128
            End Type

Function getVersion() As String
               Dim osinfo As OSVERSIONINFO
               Dim retvalue As Integer
 
               osinfo.dwOSVersionInfoSize = 148
               osinfo.szCSDVersion = Space$(128)
               retvalue = GetVersionExA(osinfo)
 
               With osinfo
               Select Case .dwPlatformId
 
                Case 1
                
                    Select Case .dwMinorVersion
                        Case 0
                            getVersion = "Windows 95"
                        Case 10
                            getVersion = "Windows 98"
                        Case 90
                            getVersion = "Windows Mellinnium"
                    End Select
    
                Case 2
                    Select Case .dwMajorVersion
                        Case 3
                            getVersion = "Windows NT 3.51"
                        Case 4
                            getVersion = "Windows NT 4.0"
                        Case 5
                            If .dwMinorVersion = 0 Then
                                getVersion = "Windows 2000"
                            Else
                                getVersion = "Windows XP"
                            End If
                    End Select
    
                Case Else
                   getVersion = "Failed"
            End Select
 
               End With

End Function


Visual Basic .Net


Top
Property accessor 'IsMdiContainer' on object 'System.Windows.Forms.Design.FormDocumentDesigner' threw the following exception:'Specified cast is not valid.'

My experience with this error found me wasting about 3 hours of my day figuring this out. Browsing several forums showed to set copylocal to "False" however in my app copylocal was already set to false. End result was, reinstall of Framework 1.1 cleared up the error. I did go through the trouble of reinstalling Vb.NET but to me it looks like some Framework installation issue which I cannot explain and doubt MS could explain either other than what was just stated (download/installation issue).



Visual Basic 5.0

Top
Start web browser from your Visual Basic application


' THERE ARE TWO VERSIONS HERE - ONE FOR VB5 and the smaller one is for VB.NET


Declare Function FindExecutable Lib "shell32.dll" Alias _
         "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As _
         String, ByVal lpResult As String) As Long


Private Sub StartWebBrowser_Click()

'Private Const SW_SHOW = 5       ' Displays Window in its current size
                                ' and position
'Private Const SW_SHOWNORMAL = 1 ' Restores Window if Minimized or
                                ' Maximized

      Dim FileName As String, Dummy As String
      Dim BrowserExec As String * 255
      Dim RetVal As Long
      Dim FileNumber As Integer

      ' First, create a known, temporary HTML file
      BrowserExec = Space(255)
      FileName = "C:\temphtm" & SYSUSERID & ".HTM"
      FileNumber = FreeFile                    ' Get unused file number
      Open FileName For Output As #FileNumber  ' Create temp HTML file
          Write #FileNumber, " <\HTML>"  ' Output text
      Close #FileNumber                        ' Close file
      ' Then find the application associated with it
      RetVal = FindExecutable(FileName, Dummy, BrowserExec)
      BrowserExec = Trim(BrowserExec)
      ' If an application is found, launch it!
      If RetVal <= 32 Or IsEmpty(BrowserExec) Then ' Error
          MsgDsp "Could not find default internet browser"
      Else
          RetVal = ShellExecute(Me.hwnd, "open", BrowserExec, _
            "www.geocities.com/polandcomputingservices", Dummy, 1)
          If RetVal <= 32 Then        ' Error
              MsgDsp "URL failed, web page not opened"
          End If
      End If
      Kill FileName                   ' delete temp HTML file
      
      HideMenu

End Sub


Visual Basic .Net

' VB.NET start browser example
' Add a link control to your form... then in the startup form load...
' the name of the link I have set up in this example is LnkPcServ


    Private Sub LnkPcServ_LinkClicked(ByVal sender As Object, ByVal e As System.Windows.Forms.LinkLabelLinkClickedEventArgs)

        ' Determine which link was clicked within the LinkLabel.
        LnkPcServ.Links(LnkPcServ.Links.IndexOf(e.Link)).Visited = True

        ' Display the appropriate link based on the value of the LinkData property of the Link object.
        System.Diagnostics.Process.Start(e.Link.LinkData.ToString())

    End Sub

' somewhere in the form startup you could then code:

        ' set up misc form controls
        LnkPcServ.Links.Add(0, 22, "www.geocities.com/polandcomputingservices")
        ' Create an event handler for the LinkClicked event.
        AddHandler LnkPcServ.LinkClicked, AddressOf Me.LnkPcServ_LinkClicked







VB.NET

Start a new form from base form in VB.NET

Top


The following Dim goes into the main body of the form

Dim F2 As New Form2()

This code is triggered by an event

Private Sub ShowForm2Button_Click(ByVal sender As System.Object, _
    ByVal e As System.EventArgs) Handles ShowForm2Button.Click

    F2.Show()

End Sub




VB.NET

Error handling in VB.NET
Top


' Multiple Exceptions option on the sample form.
Private Sub MultipleExceptions()
  Dim lngSize As Long
  Dim s As FileStream

  Try
    s = File.Open(txtFileName.Text, FileMode.Open)
    lngSize = s.Length
    s.Close()
  Catch e As ArgumentException
    MessageBox.Show( _
     "You specified an invalid filename. " & _
     "Make sure you enter something besides spaces.")
  Catch e As FileNotFoundException
    MessageBox.Show( _
     "The file you specified can't be found. " & _
     "Please try again.")
  Catch e As ArgumentNullException
    MessageBox.Show("You passed in a Null argument.")
  Catch e As UnauthorizedAccessException
    MessageBox.Show( _
     "You specified a folder name, not a file name.")
  Catch e As DirectoryNotFoundException
    MessageBox.Show( _
     "You specified a folder that doesn't exist " & _
     "or can't be found.")
  Catch e As SecurityException
    MessageBox.Show( _
     "You don't have sufficient rights " & _
     "to open the selected file.")
  Catch e As IOException
    ' A generic exception handler, for any IO error
    ' that hasn't been caught yet. Here, it ought
    ' to just be that the drive isn't ready.
    MessageBox.Show( _
     "The drive you selected is not ready. " & _
     "Make sure the drive contains valid media.")
  Catch e As Exception
    MessageBox.Show("An unknown error occurred.")
  End Try
End Sub


or raise an exception event yourself in VB.NET:

Catch ex As System.Exception
   Throw New ApplicationException _
      ("You had an error in your application")




VB.NET

Screen coordinate calculation in VB.NET
Top


        Dim MessageForm As New PayrlMessageForm
        MessageForm.LblCaller.Text = CallerId
        MessageForm.LblMessage.Text = MessageToShow

        ' calculate proper positioning of message window (bottom right corner)
        MessageForm.Top = CInt(Screen.PrimaryScreen.WorkingArea.Bottom - MessageForm.Height)
        MessageForm.Left = CInt(Screen.PrimaryScreen.WorkingArea.Right - MessageForm.Width)
        If CriticalError = True Then
            MessageForm.LblSeverityLevel.Text = "Critical - this program will be stopped"
        Else
            MessageForm.LblSeverityLevel.Text = "Informational message"
        End If

        MessageForm.Show()



VB.NET

Setting control color in VB.NET
Top


        If CriticalError = True Then
            MessageForm.LblSeverityLevel.Text = "Critical - this program will be stopped"
            MessageForm.LblSeverityLevel.ForeColor = System.Drawing.Color.IndianRed
            MessageForm.LblMessage.ForeColor = System.Drawing.Color.IndianRed
        Else
            MessageForm.LblSeverityLevel.Text = "Informational message"
        End If


VB.NET

Tab control event in VB.NET
Top


Confusing in the sense that TabPage1 click event is not used, try using the main object, in the case below it is TabMain.

    Private Sub TabMain_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles TabMain.Click

        Select Case TabMain.SelectedTab.Name
            Case "TabPage1" ' tab1
            Case "TabPage2" ' tab2
            Case "TabPage3" ' tab3
                MessageHandling("Click event is for tab3", False, "Tab Main / Click")
            Case "TabPage4" ' tab4
            Case "TabPage5" ' tab5
            Case "TabPage6" ' tab6
            Case "TabPage7" ' tab7
            Case "TabPage8" ' tab8
                If LblBackupFolder.Text = "None" Then
                    MessageHandling("Your back-up options need to be established", False, "Exit tab / Click")
                End If

        End Select


    End Sub

' you can trap tab events on a tab control using:

    Private Sub TabAim_SelectedIndexChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles TabAim.SelectedIndexChanged

        Static StartUpComplete As Boolean

        If FormLoading = False And StartUpComplete = True Then
            ' do some screen display routine
            MQDISPLAY()
             ' in the mqdisplay routine you can check which tab is active
             ' If tabaim.selectedtab.text="Main" then .... do somethin
        Else
            StartUpComplete = True
        End If

    End Sub



VB.NET

Simple sleep event in VB.NET
Top


System.Threading.Thread.Sleep(8000)



VB.NET

Writing to the Framework event application log in VB.NET
Top


Browse framework events by viewing under control panel / performance and maintenance / administrative tools / event viewer

        If Loggable = True Then

            ' is the eventlog registered?
            StandardEventLogName = EventLog.LogNameFromSourceName("MyAppName", ".")
            ' register event log
            If StandardEventLogName = "" Then
                EventLog.CreateEventSource("MyAppName", "Application")
                StandardEventLogName = "MyAppName"
            End If
            EventLog.WriteEntry(StandardEventLogName, MessageToShow)

        End If


VB.NET

Using the listview control in VB.NET
Top



        LstNames.Clear()  ' name of listview control; make sure "details" is set
        ' Add ListView Columns
        LstNames.Columns.Add("Num", LstNames.Width / 10, HorizontalAlignment.Left)
        LstNames.Columns.Add("Last name", LstNames.Width / 4, HorizontalAlignment.Left)
        LstNames.Columns.Add("First name", LstNames.Width / 5, HorizontalAlignment.Left)

        ' read through and populate name list
        Dim NamStr(2) As String
        Dim NamItm As ListViewItem

        DBClass.Names.MoveFirst()
        Do While DBClass.Names.EOF = False

            NamStr(0) = "" : NamStr(1) = "" : NamStr(2) = "" 
            NamStr(0) = Str(DBClass.Names.Fields("Number").Value)
            If Not IsDBNull(DBClass.Names.Fields("LastName").Value) Then
                NamStr(1) = DBClass.Names.Fields("LastName").Value
            End If
            If Not IsDBNull(DBClass.Names.Fields("FirstName").Value) Then
                NamStr(2) = DBClass.Names.Fields("FirstName").Value
            End If

            NamItm = New ListViewItem(NamStr)
            LstNames.Items.Add(NamItm)
            DBClass.Names.MoveNext()
        Loop


' sample code to determine which listview item has been selected...

    Private Sub LvTopTen_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles LvTopTen.Click
        If LvTopTen.Items.Count = 0 Then Exit Sub
        If LvTopTen.SelectedItems.Count = 0 Then Exit Sub
        If LvTopTen.SelectedItems(0).SubItems(0).Text <> InvestmentName Then
            GetInvName(LvTopTen.SelectedItems(0).SubItems(0).Text)
        End If
    End Sub

' sample code to loop through and update listview content using .subitems
' inv.LastPrice and inv.Symbol is a defined structure within an arraylist

For X = 0 To LvMarket.Items.Count - 1
    If UCase(LvMarket.Items(X).SubItems(0).Text) = UCase(inv.Symbol) Then
       If Val(LvMarket.Items(X).SubItems(2).Text) > 0 Then
          SharesOwned = Val(LvMarket.Items(X).SubItems(6).Text) / Val(LvMarket.Items(X).SubItems(2).Text)
       Else
           SharesOwned = 0
      End If
      ' did pps change?
      If Val(LvMarket.Items(X).SubItems(2).Text) <> inv.LastPrice Then
         If Val(LvMarket.Items(X).SubItems(2).Text) > inv.LastPrice Then
            ' down
            LvMarket.Items(X).SubItems(2).Text = Microsoft.VisualBasic.Format(inv.LastPrice, "###0.00")
            LvMarket.Items(X).SubItems(2).BackColor = Color.Maroon
         Else
            ' up
            LvMarket.Items(X).SubItems(2).Text = Microsoft.VisualBasic.Format(inv.LastPrice, "###0.00")
            LvMarket.Items(X).SubItems(2).BackColor = Color.DarkGreen
         End If
                        End If

      End If

Next



VB.NET

Reading MS ACCESS schema including tables, columns and foreign keys in VB.NET
Top



IMPORTANT - This example loads a listview control of table columns, size, description, type and foreign keys. The name of the listview control is 'lstdbfields' having the view property set to 'details'. Also, I have a class declaring some of the connection and datatables used below as follows:

Public Class AdoDBclass
    Public Shared DBPathAndFile As String
    Public Shared MSDBConn As New OleDb.OleDbConnection
    Public Shared MSDBRecordset As New ADODB.Recordset
    Public Shared MSDBSchema As New OleDb.OleDbSchemaGuid
    Public Shared MSDBTable As New DataTable
    Public Shared MSDBColumn As New DataTable
    Public Shared MSDBForeign As New DataTable
End Class

This code has been taken from my adodbrpt report generator project.

        Try
            AdoDBclass.MSDBConn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & AdoDBclass.DBPathAndFile
            AdoDBclass.MSDBConn.Open()

        Catch ex As Exception
            MsgBox("Unable to open provided MS Access file", MsgBoxStyle.Critical)
            AdoDBclass.DBPathAndFile = Nothing
            LstDbFields.Visible = False
            Exit Sub
        End Try

        LstDbFields.Visible = True

        '
        ' Add ListView Columns
        LstDbFields.Clear()
        LstDbFields.Columns.Add("Table", LstDbFields.Width / 10, HorizontalAlignment.Left)
        LstDbFields.Columns.Add("Field", LstDbFields.Width / 6, HorizontalAlignment.Left)
        LstDbFields.Columns.Add("Type", LstDbFields.Width / 12, HorizontalAlignment.Left)
        LstDbFields.Columns.Add("Size", LstDbFields.Width / 12, HorizontalAlignment.Left)
        LstDbFields.Columns.Add("Description", LstDbFields.Width / 3, HorizontalAlignment.Left)
        LstDbFields.Columns.Add("Owner foreign key", LstDbFields.Width / 8, HorizontalAlignment.Left)

        ' read through and populate listview control
        Dim DbStr(5) As String, CurTableName As String, CurColumnName As String
        Dim ColType As String
        Dim DbItm As ListViewItem, I As Integer, J As Integer, K As Integer

        AdoDBclass.MSDBTable = AdoDBclass.MSDBConn.GetOleDbSchemaTable
(OleDb.OleDbSchemaGuid.Tables, New Object() {Nothing, Nothing, 
Nothing, "TABLE"})
        AdoDBclass.MSDBForeign = AdoDBclass.MSDBConn.GetOleDbSchemaTable
(OleDb.OleDbSchemaGuid.Foreign_Keys, New Object() {Nothing, Nothing, Nothing, 
Nothing})

        For I = 0 To AdoDBclass.MSDBTable.Rows.Count - 1
            CurTableName = AdoDBclass.MSDBTable.Rows(I).Item
("TABLE_NAME").ToString
            ' now that we have a table name, get columns
            AdoDBclass.MSDBColumn = AdoDBclass.MSDBConn.GetOleDbSchemaTable
(OleDb.OleDbSchemaGuid.Columns, New Object() {Nothing, Nothing, CurTableName, 
Nothing})
            For J = 0 To AdoDBclass.MSDBColumn.Rows.Count - 1
                DbStr(0) = "" : DbStr(1) = "" : DbStr(2) = "" : DbStr(3) = "" : DbStr(4) = "" : DbStr(5) = ""
                DbStr(0) = CurTableName
                'DbStr(1) = AdoDBclass.MSDBColumn.Rows(J).ItemArray(3).ToString
                CurColumnName = AdoDBclass.MSDBColumn.Rows(J).Item("COLUMN_NAME").ToString
                DbStr(1) = CurColumnName
                '------
                For K = 0 To AdoDBclass.MSDBForeign.Rows.Count - 1
                    If CurTableName = AdoDBclass.MSDBForeign.Rows(K).Item
("FK_TABLE_NAME").ToString And _
                       CurColumnName = AdoDBclass.MSDBForeign.Rows(K).Item
("FK_COLUMN_NAME").ToString Then
                        DbStr(5) = AdoDBclass.MSDBForeign.Rows(K).Item
("PK_TABLE_NAME").ToString & "." & AdoDBclass.MSDBForeign.Rows(K).Item
("PK_COLUMN_NAME").ToString
                    End If
                Next K


                '------
                ColType = AdoDBclass.MSDBColumn.Rows(J).Item("DATA_TYPE").ToString
                Select Case ColType
                    Case "2"
                        DbStr(2) = "Long Integer"
                    Case "3"
                        DbStr(2) = "Integer"
                    Case "5"
                        DbStr(2) = "Double"
                    Case "6"
                        DbStr(2) = "Currency"
                    Case "7"
                        DbStr(2) = "Short date"
                    Case "11"
                        DbStr(2) = "Boolean"
                    Case "17"
                        DbStr(2) = "Byte"
                    Case "130"
                        DbStr(2) = "String"
                    Case Else
                        DbStr(2) = ColType
                End Select
                If ColType = "130" Then
                    DbStr(3) = AdoDBclass.MSDBColumn.Rows(J).Item("CHARACTER_MAXIMUM_LENGTH").ToString
                    If Val(AdoDBclass.MSDBColumn.Rows(J).Item("CHARACTER_MAXIMUM_LENGTH").ToString) = 0 Then
                        DbStr(3) = "9999"
                    End If
                End If
                DbStr(4) = AdoDBclass.MSDBColumn.Rows(J).Item("DESCRIPTION").ToString
                DbItm = New ListViewItem(DbStr)
                LstDbFields.Items.Add(DbItm)
            Next J
            Next I

        'Explicitly close - don't wait on garbage collection.
        AdoDBclass.MSDBConn.Close()




Visual basic

Limiting the number of running instances of your application in Visual Basic
Top



declare sub writeprivateprofilestring lib "kernel" 
(byval section as string, byval entry as string, byval newitem as string, byval filename as string)

declare function getprivateprofileint lib "kernel" 
(byval section as string, byval entry as string, byval default as integer, byval filename as string) as integer

declare function sendmessage lib "user" 
(byval hwnd as integer, byval msg as integer, byval wp as integer, byval lp as long) as integer

Add code to your form_load:

if app.previnstance then ' found running copy
   on local error goto cantactivate ' in case something goes wrong
   form1.caption="Form1." ' change title bar of this instance
   x=doevents() ' so it doesn't match what we are
                ' searching for
   appactivate "Form1" ' caption bar text to find here!
   sendkeys "% R", TRUE  ' restore application to window
   on local error goto 0
   unload form1
   on error goto 0
   end
end if

exit sub

cantactivate:

   if err=5 then  ' illegal function call happened get hwnd and send message
      temp=getprivateprofileint("Background", "Hwnd", 0, "Form1.INI")
      if temp<>0 then
         ' send wm_keyup message to background
         l&=sendmessage(temp,&h101,255,255)
      else
         beep: msgbox "Application is already running.", 48
         ' just in case something else happens
     end if
   end if
resume next

' Place this code in the form_keyup event

if keycode=255 then
   ' if in background and they get this event pop up the app
   form1.windowstate=0
end if



Visual basic

Create hexadecimal date serial numbers
Top



function ds2hex (D#) as string 
   seconds#=(D#-1)*86400
   if seconds# > 4294967294# then ' make sure if will fit in eight bytes
      ds2hex=""
   elseif seconds# < 2147483647# then
      ds2hex=hex$(seconds#+1)
   else
      ds2hex=hex$(seconds#-4294967295#)
   end if
end function

function hex2ds (H$) as double
   if len(H$) then
      seconds#=val("&H" & H$)
     if seconds#>0 then
        hex2ds=(seconds#-1)/86400+1
     else
        hex2ds=(seconds#+4294967295#)/86400+1
     end if
end function



Visual basic

Compressing and uncompressing data - LZW and old Quick Basic
Top


My personalized modified version of lzw data compression


----------------------------------------------------------------------

CONST FALSE% = 0, TRUE% = NOT FALSE%
CONST PREFIX% = 0, SUFFIX% = 1, LINK% = 2
CONST MAXTABLE% = 4095

declare sub outputuncompvalue (i%)
declare sub outputcompvalue (i)
declare sub compressfile()
declare sub done()
declare sub init (inf as string, outf as string)
declare sub insertentry()
declare sub storetable(filetbl$)
declare sub uncompressfile()
declare function inputuncompvalue%()
declare function inputcompvalue%()
declare function managetbl%()
declare function expandvalue%(inputvalue%, outputstatus%)

SUB Compressfile
   cur&=0 ' counter for screen
   prefixcandidate=inputuncompvalue
   loop1:
     cur&=cur&+1
     if (cur& and 127)=127 then
        locate 10,10:print using "###,###"; cur&;
     end if

     suffixcandidate=inputuncompvalue
     if eof(1) then
        outputcompvalue prefixcandidate
        exit sub
     end if
     foundcode=managetbl
     if foundcode then
        prefixcandidate=foundcode
     else
        outputcompvalue(prefixcandidate)
        prefixcandidate=suffixcandidate
     end if
     
     goto loop1

end sub

sub done ' closes the files
    close 1,2
end sub

function expandvalue% (inputvalue%, outputstatus%)
   ' expandvalue expands compression codes
    if inputvalue > 255 then
       kprefix=codetbl(inputvalue,prefix)
       ksuffix=codetbl(inputvalue,suffix)
       if kprefix>255 then
          kreturned=expandvalue(kprefix,outputstatus)
       else
          kreturned=kprefix
          if outputstatus then outputuncompvalue(kprefix)
       end if
       if outputstatus then outputuncompvalue(ksuffix)
    else
       kreturned=inputvalue ' return ascii value if passed ascii value
    end if
    expandvalue%=kreturned
end function

sub init(inf as string, outf as string)
TableFull = FALSE
tabletop=255

FOR I% = 0 TO MAXTABLEentries
    HITTBL(I%) = 0: CODETBL(I%, LINK%) = 0
    IF I% > 255 THEN
       CODETBL(I%, PREFIX%) = 0: CODETBL(I%, SUFFIX%) = 0
    ELSE
       CODETBL(I%, PREFIX%) = -1: CODETBL(I%, SUFFIX%) = I%
    END IF
NEXT

inputfilenbr=freefile
open inf for binary as #inputfilenbr
outputfilenbr=freefile
output outf for binary as #outputfilenbr

end sub

function inputcompvalue%
   get inputfilenbr,,i%
   inputcompvalue%=i%
end function

function inputuncompvalue%
   c$=" "
   get inputfilenbr,,c$
   inputuncompvalue%=asc(C$)
end function

sub insertentry
   codetbl(tabletop,prefix)=prefixcandidate
   codetbl(tabletop,suffix)=suffixcandidate
   if tabletop=maxtableentries then tablefull=true
end sub

Function managetbl

  Found% = FALSE: ENDOFLINKS% = FALSE
  IF HITTBL(PREFIXCANDIDATE)<>0 THEN
   CURPTR% = HITTBL(PREFIXCANDIDATE)
   DO
    IF CODETBL(CURPTR%, PREFIX%) = PREFIXCANDIDATE AND CODETBL(CURPTR%, SUFFIX%) = SUFFIXCANDIDATE THEN
       Found% = TRUE%
    ELSE
       IF CODETBL(CURPTR%, LINK%)<>0 THEN
          CURPTR% = CODETBL(CURPTR%, LINK%)
       ELSE
          ENDOFLINKS% = TRUE%
       END IF
    END IF
   LOOP UNTIL Found% OR ENDOFLINKS%
END IF

IF Found% THEN
   Managetbl% = CURPTR%
ELSE
   IF NOT TableFull THEN
      TableTop = TableTop + 1
      insertentry
      IF HITTBL(PREFIXCANDIDATE) = 0 THEN
         HITTBL(PREFIXCANDIDATE) = TableTop
      ELSE
         CODETBL(CURPTR%, LINK%) = TableTop
      END IF
   END IF
   Managetbl% = FALSE%
END IF
end function ' managetbl    

sub outputcompvalue(i%)
    put outputfilenbr,,i%
end sub

sub outputuncompvalue(I%)
   c$=chr$(I%)
   put outputfilenbr,,c$
end sub

sub storetable (filetbl$)
   open "o",filenbr, filetbl$
   for i=256 to tabletop
       print #filenbr, using "####  ";i;
       print #filenbr, using "####  "; codetbl(i, prefix);
       print #filenbr, using "####  ";codetbl(i, suffix);
       print #filenbr, using "####  ";codetbl(i, linke);
       for j=prefix to suffix
           if codetbl(i,j)<255 and codetbl(i,j)>=32 then
              print #filenbr, using "! "; chr$(codetbl(i, j));
           else
              print #filenbr, "  ";
           end if
       next j
    next i
    close filenbr
end sub

sub uncompressfile
   ctr&=0
   prefixcandidate=inputcompvalue
   while not eof91)
      ctr&=ctr&+1
      if (ctr& and 127)=127 then
          locate 10, 10:print using "###,###  "; ctr&;
      end if
      if prefixcandidate<256 then outputuncompvalue(prefixcandidate)
      suffixcandidate=inputcompvalue
      if suffixcandidate>255 then
         suffixcopy=suffixcandidate
         if tabletop+1=suffixcandidate then
            suffixcandidate=expandvalue(prefixcandidate,false)
            found=managetbl
            suffixcandidate=suffixcopy
            dummy=expandvalue(suffixcandidate,true)
         else
            suffixcandidate=expandvalue(suffixcandidate, true) ' normal expand
            found=managetbl
            suffixcandidate=suffixcopy
         end if
      else
         found=managetbl
      end if
      prefixcandidate=suffixcandidate
      if eof(1) then exit sub

   wend

end sub





VB.NET

Sample code showing a bubble sort
Top




        ' do bubble sort
        If SectorMax > 0 Then

            Dim X As Integer, Y As Integer, Temp As Decimal, Temp2 As Decimal
            Dim Sortexit As Integer, Nme As String

            For X = 1 To SectorMax
                Sortexit = 0
                For Y = SectorMax To X Step -1
                    If AimControl.TRINRatio(y) < AimControl.TRINRatio(y - 1) Then
                        ' swap values
                        Temp = AimControl.TRINRatio(y)
                        Nme = AimControl.TRINName(y)
                        AimControl.TRINRatio(y) = AimControl.TRINRatio(y - 1)
                        AimControl.TRINName(y) = AimControl.TRINName(y - 1)
                        AimControl.TRINRatio(y - 1) = Temp
                        AimControl.TRINName(y - 1) = Nme
                        Sortexit = 1
                    End If
                Next
                If Sortexit = 0 Then
                    x = SectorMax
                Else
                    Sortexit = 0
                End If
            Next





Determine system directory with and without using windows API

Visual Basic 4, 5, 6 and VB.NET


Top




' "windir" can be lower case, upper case or mixed case
windowsDirectory = Environ$("windir")

You can expand on this tip to retrieve the name of the SYSTEM directory, 
without using any API call. In fact, you have to take into account that the 
this directory is named SYSTEM under Windows 95/98 and SYSTEM32 under Windows 
NT (and 2000). If you also notice that the OS environment variable exists only 
in Windows NT (and 2000) you can determine the System directory with just one 
line of code: 

systemDirectory = Environ$("windir")  & IIf(Len(Environ$("OS")), "\SYSTEM32", _
    "\SYSTEM")

__________________________________________________________________________

The following is with the windows API

Private Declare Function GetSystemDirectory Lib "kernel32" Alias _
    "GetSystemDirectoryA" (ByVal lpBuffer As String, _
    ByVal nSize As Long) As Long

Function SystemDirectory() As String
    Dim buffer As String * 512, length As Integer
    length = GetSystemDirectory(buffer, Len(buffer))
    SystemDirectory = Left$(buffer, length)
End Function

__________________________________________________________________________

The following is used from VB.NET  - references my documents as initialpath

OpenFileDialog1.InitialDirectory = Environment.GetFolderPath
(Environment.SpecialFolder.Personal)




Build dynamic control indexed arrays in VB.NET
Top


Visual Basic 4, 5, 6 and VB.NET


Maybe you have noticed VB.NET (at this time) doesn't permit controls to be 
indexed. You can still do this but it is time consuming.

Open a class such as:
Public Class Ctl
    Public Shared Offs(22) As Label
    Public Shared Tx(22) As TextBox
    Public Shared Hex1(22) As TextBox
    Public Shared Hex2(22) As TextBox
    Public Shared Hex3(22) As TextBox
    Public Shared Hex4(22) As TextBox
    Public Shared Hex5(22) As TextBox
End Class

this subroutine in my program_load event builds 22 rows of labels/textboxes:

        Dim X As Integer
        For X = 1 To 22
            BuildLblOffset(X, PnlOffset.Height / 22, PnlOffset.Width)
            BuildCharDisplay(X, PnlCharDisplay.Height / 22, 
PnlCharDisplay.Width)
            BuildHex1Display(X, Pnl1Hex.Height / 22, Pnl1Hex.Width)
            BuildHex2Display(X, Pnl1Hex.Height / 22, Pnl1Hex.Width)
            BuildHex3Display(X, Pnl1Hex.Height / 22, Pnl1Hex.Width)
            BuildHex4Display(X, Pnl1Hex.Height / 22, Pnl1Hex.Width)
            BuildHex5Display(X, Pnl1Hex.Height / 22, Pnl1Hex.Width)
        Next

    Sub BuildLblOffset(ByVal LabelCount As Integer, ByVal LabelHeight As 
Integer, ByVal LabelWidth As Integer)
        Dim Lbloffset As New Label
        Lbloffset.Height = LabelHeight
        Lbloffset.Width = LabelWidth
        Lbloffset.Top = ((LabelCount - 1) * LabelHeight)
        Lbloffset.Left = 1
        Lbloffset.Text = ""
        Lbloffset.Font = New System.Drawing.Font("Courier", 8.25!, 
System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, 
Byte))
        Ctl.Offs(LabelCount) = Lbloffset
        PnlOffset.Controls.Add(Ctl.Offs(LabelCount))
    End Sub

    Sub BuildCharDisplay(ByVal TextCount As Integer, ByVal textHeight As 
Integer, ByVal textWidth As Integer)
        Dim TxtCharDisplay As New TextBox
        TxtCharDisplay.Height = textHeight
        TxtCharDisplay.Width = textWidth
        TxtCharDisplay.Top = ((TextCount - 1) * textHeight)
        TxtCharDisplay.Left = 1
        TxtCharDisplay.Enabled = False
        TxtCharDisplay.Text = ""
        TxtCharDisplay.MaxLength = 20
        TxtCharDisplay.ForeColor = System.Drawing.Color.Black
        TxtCharDisplay.Font = New System.Drawing.Font("Arial Terminal", 8.0!, 
System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, CType(0, 
Byte))
        Ctl.Tx(TextCount) = TxtCharDisplay
        PnlCharDisplay.Controls.Add(Ctl.Tx(TextCount))
    End Sub

of course my buildhexdisplay routines is similar to the buildchardisplay shown 
above...  the pnloffset and pnlchardisplay are both panels on a main form - 
reference points (top/left) is zero within the top/leftmost portion of the 
panel. Code above is from my QEdit binary file 
browser.

Please dispose dynamically created controls where possible:

    Private Sub CmdQuit_Click(ByVal sender As System.Object, ByVal e As 
System.EventArgs) Handles CmdQuit.Click
        Pnl1Hex.Dispose()
        Pnl2Hex.Dispose()
        Pnl3Hex.Dispose()
        Pnl4Hex.Dispose()
        Pnl5Hex.Dispose()
        PnlOffset.Dispose()
        PnlCharDisplay.Dispose()
        Application.Exit()

    End Sub




Trapping keypress events in VB.NET
Top


VB.NET


Check keypreview on your form, be sure it is "True", build the following 
attached to your app keypress event:

    Private Sub FORMNAME_KeyUp(ByVal sender As Object, ByVal e As 
System.Windows.Forms.KeyEventArgs) Handles MyBase.KeyUp
        Dim Keyascii As Integer = AscW(e.KeyCode)
        CmdFocus.Select()
        Select Case e.KeyCode
            Case Keys.PageDown
                BrowseFile(False, False, False, True, False, False)
            Case Keys.PageUp
                BrowseFile(False, False, True, False, False, False)
            Case Keys.Up
                BrowseFile(True, False, False, False, False, False)
            Case Keys.Down
                BrowseFile(False, True, False, False, False, False)
            Case Keys.Home
                BrowseFile(False, False, False, False, True, False)
            Case Keys.End
                BrowseFile(False, False, False, False, False, True)
        End Select
    End Sub

The browsefile subroutine expects to know what key was pressed in order to do 
proper paging / scrolling.




Trapping mouse wheel events in VB.NET
Top


VB.NET


build the following attached to your app mousewheel event:

    Private Sub FORMNAME_MouseWheel(ByVal sender As Object, ByVal e As 
System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseWheel
        Dim Clks As Integer
        Clks = e.Delta
        If Clks > 0 Then ' wheel moved forward
            BrowseFile(True, False, False, False, False, False)
        ElseIf Clks < 0 Then ' wheel moved backward
            BrowseFile(False, True, False, False, False, False)
        End If

    End Sub

this is basic but it will do the trick



Distributing .exe software using VB.NET
Top


VB.NET


After building your software how do you distribute it as an installable 
package? There are many steps... I'll try to be straight forward and not 
confuse you too much.

FILE -> NEW -> PROJECT -> SETUP AND DEPLOYMENT PROJECTS - SET NAME OF SETUP 
FILE

CLICK NAME OF SETUP PROJECT -> PROPERTIES -> ADD/REMOVE PROGRAM ICON -> 
BROWSE -> LOCATE ICON FOR PROGRAM -> SELECT APPLICATION FOLDER

CLICK "FILE SYSTEM" (LOOK FOR.. IT IS THERE) -> HIGHLIGHT APPLICATION FOLDER -
> IN RIGHT PANE RIGHT CLICK ADD -> PROJECT OUTPUT -> PRIMARY OUTPUT -> OKAY

CLICK "FILE SYSTEM" -> HIGHLIGHT USERS DESKTOP -> IN RIGHT PANE RIGHT CLICK 
ADD NEW SHORTCUT -> SET YOUR DESIRED NAME OF SHORTCUT -> HIGHLIGHT THE USERS 
FOLDER SHORTCUT -> PROPERTIES -> ICON -> BROWSE -> SELECT PRIMARY OUTPUT AND 
SET PROPER ICON

CLICK "FILE SYSTEM" -> CLICK USERS FOLDER -> ADD "NEW FOLDER" IF YOU NEED TO -
> IN RIGHT PANE OF DESIRED FOLDER UNDER USERS FOLDER -> CREATE NEW SHORTCUT -> 
NAME TO YOUR PREFERENCE -> HIGHLIGHT THE NEW SHORTCUT -> PROPERTIES -> ICON -> 
SET LOCATION AND ICON TO USE

RIGHT CLICK SETUP PROJECT -> PROPERTIES -> CONFIGURATION -> RELEASE -> RIGHT 
CLICK SETUP PROJECT -> BUILD -> VIEW BOTTOM OF SCREEN FOR ERRORS OR SUCCESS

LOCATE YOUR VISUAL STUDIO PROJECT, BROWSE SETUP FOLDER UNDER RELEASE -> ALL 
THESE FILES CAN BE ZIPPED TOGETHER TO AUTO EXECUTE THE SETUP.EXE FILE

I did this instruction on the fly (not while doing it) hopefully you can 
figure this all out! Once you get the hang of it will be easier.




You do not have a license to use this ActiveX control VB.NET
Top


VB.NET


PRB: Errors when you use Visual Basic 6.0 controls in Visual Studio .NET

Add the licensing keys to the registry

Warning If you use Registry Editor incorrectly, you may cause serious problems 
that may require you to reinstall your operating system. Microsoft cannot 
guarantee that you can solve problems that result from using Registry Editor 
incorrectly. Use Registry Editor at your own risk. To add the licensing keys 
for the Visual Basic 6.0 controls to the registry, follow these steps: 1. 
Insert the Visual Studio .NET Installation Disk that has the \Extras\VB6 
Controls folder in the in the CD-ROM or in the DVD-ROM drive. The following 
list describes what disk to use for each product edition on CD-ROM: 

Visual Studio .NET 2002 (not the Microsoft Developer Network [MSDN] disk) � 
All Enterprise Editions - Disk 4 
� Professional Edition - Disk 4 
� Standard Edition - Disk 3 
� Academic Edition - Disk 4 
Visual Studio .NET 2003 (not the MSDN disk) � All Enterprise Editions - Disk 2 
� Professional Edition - Disk 2 
� Standard Edition - Disk 1 
� Academic Edition - Disk 2 
 
2. Click Start, and then click Run. 
3. In the Run dialog box, type regedit, and then click OK. 
4. In the Registry Editor dialog box, click Import on the File menu. 
5. Locate the \Extras\VB6 Controls folder on your Visual Studio .NET 
Installation CD-ROM, select the VB6Controls.reg file, and then click Open. 
This inserts all of the Visual Basic 6.0 ActiveX Controls license keys in the 
registry. 




PRB: Error "Unrecognized Database Format" When You Upgrade to Access 2000 or 2002 VB.NET
Top


VB.NET


PRB: Error "Unrecognized Database Format" When You Upgrade to Access 2000 or 2002

Did you convert a project which used a different version of MS Access than what you are trying to use now?

Solution explorer -> References -> DAO <- remove

Project -> Add reference -> Select Microsoft DAO 3.6 to add reference

TRY TRY AGAIN 



Structures and arraylist in VB.NET are great tools to use!
Top


VB.NET




'define these to build an arraylist!

    Structure NetWorthGraphData
        Dim MonthlyPeriod As String
        Dim Amt As Long
        Sub New(ByVal MonthAndYear As String, ByVal DollarAmt As Long)
            Me.MonthlyPeriod = MonthAndYear
            Me.Amt = DollarAmt
        End Sub
    End Structure

 Dim NetWorthData As New System.Collections.ArrayList

' adding the values to the structure
NetWorthData.Add(New NetWorthGraphData(Dte, Net(X)))

' referencing the stored arraylist - note here "gd" references each arraylist item

        For Each gd As NetWorthGraphData In NetWorthData
            '  Calculate Bar Height
            Dim BarHeight As Integer = CInt(gd.Amt * VertScale)
            '  Create a rectangle for the Bar
            BarRect = New Rectangle(BarStartX, BarStartY, CInt(BarWidth), _
                  BarHeight)
            '  Pull the Y point upwards so that the bar (rectangle) will 
            '  stretch back down to the baseline when drawn
            BarRect.Offset(0, -BarHeight)
            '  Fill the Bar
            g.FillRectangle(BarBrush, BarRect)
            '  Optionally draw a line round the bar
            g.DrawRectangle(LinePen, BarRect)
            '  Increase the X value by bar width plus gap
            '  ready for next bar to be drawn.
            BarStartX += CInt(BarWidth + BarGap)
        Next


' how many items are there in the arraylist?
if NetWorthData.Count >0 then .....





Building pie or bar charts in VB.NET
Top


VB.NET



This is great stuff - learn how to build a chart without "MSCHART" ocx... examples provided are pie and bar charts - enjoy I did!


http://www.devcity.net/Articles/135/2/article.aspx





Loading a bitmap into a picture box at run time
Top


VB.NET


' define a bitmap class

Public Class BitmapClass
    Public Shared UpArrow As Bitmap
    Public Shared DownArrow As Bitmap
    Public Shared BarChart As Bitmap
End class

' embed the bitmap in your program:
'   Project -> Add existing item -> select the bitmap to add
'       once added, select the bitmap and change the build action to "Embedded Resource"


' somewhere in your start-up form load... do loading of bitmap

        ' load bitmaps to be used
        Dim oStream As System.IO.Stream
        Dim oAssembly As System.Reflection.Assembly
        Dim sBMP As String

        sBMP = Application.ProductName & ".Up.bmp"
        '..
        AimControl.UpArrow = GetEmbeddedBitmap(sBMP)

        sBMP = Application.ProductName & ".Down.bmp"
        '..
        AimControl.DownArrow = GetEmbeddedBitmap(sBMP)

        sBMP = Application.ProductName & ".barchart.bmp"
        '..
        AimControl.BarChart = GetEmbeddedBitmap(sBMP)


' add this subroutine in a module or somewhere in a form that is using it
#Region " GetEmbeddedBitmap - strName"
    Function GetEmbeddedBitmap(ByVal strName As String) As Bitmap
        Return New _
    Bitmap(System.Reflection.Assembly.GetExecutingAssembly.GetManifestResourceStream(strName))
        'strName= ..
    End Function
#End Region

' if you're having trouble determining the "special" embedded resource name use this routine:

    Function GetListOfEmbeddedResources() As Array
        Return _
         System.Reflection.Assembly.GetExecutingAssembly.GetManifestResourceNames
    End Function

'''''''HERE IS SAMPLE CODE TO LOAD .ICO FILE AS EMBEDDED RESOURCE'''''''

        Dim oStream As System.IO.Stream
        Dim oAssembly As System.Reflection.Assembly
        Dim sICO As String

        'open the executing assembly
        sICO = Application.ProductName & ".UpArrow.ICO"
        oAssembly = System.Reflection.Assembly.LoadFrom(Application.ExecutablePath)
        'create stream for image (icon) in assembly
        oStream = oAssembly.GetManifestResourceStream(sICO)
        'create new bitmap from stream
        AimControl.BigUpArrow = CType(Image.FromStream(oStream), Bitmap)






Using VB.NET internet download capabilities
Top


VB.NET


' add the net features into your project form that will access internet
Option Strict Off
Option Explicit On 
Imports System.Net
Imports System.IO

' here is sample logic used to download stock quotes

   Public Sub GetFinancials()
        '
        '
        Dim Part1 As String
        Dim Part2 As String
        Dim Tck As String


        'WebPageAddr = "http://quote.yahoo.com/d/quotes.csv?s="
        'SpecialTags = "&f=sb4jkl1d1t1c1ohgvj1p5p6err6r7ys6s7d&e=.csv"

        ' special tags used:
        'sb4jkl1d1t1c1ohgvj1p5p6owerr6r7ys6s7d

        's   xxx symbol
        'b4  8.59    Book Value Per Share (mrq):
        'j   26.45   52 week low
        'k   50.00   52 week high
        'l1 (L1) 48.36   last trade price only
        'd1  7/8/2005    last trade date
        't1  4:01pm  last trade time
        'c1  -0.64   change
        'o   49.21   open price
        'h   49.43   days high
        'g   48.24   days low
        'v   3471800 volume
        'j1  24.458b mkt cap
        'p5  1.25    price/sales
        'p6 price / book
        'e   -1.211  earnings per share
        'r   n/a pe ratio
        'r6  20.85   price/eps current year
        'r7  18.49   price/eps next year
        'y       dividend yield
        's6  19.85b  revenue
        's7  2.90    %shares short
        'd           dividend per share

        Dim RequestInternetQuote As Boolean
        Dim X As Integer
        RequestInternetQuote = True


        If RequestInternetQuote = True Then

            With AimDb.RsInvestments
                If .RecordCount > 0 Then
                    .MoveFirst()
                    Do

                        If IsDBNull(.Fields("AimInvTicker").Value) Then
                        ElseIf .Fields("AimType").Value = "Stock" Then
                            NumInvestments = NumInvestments + 1
                            If Len(Ticker) = 0 Then
                                Tck = LCase(LTrim(RTrim(.Fields("Ticker").Value)))
                            Else
                                Tck = Tck & "+" & LCase(LTrim(RTrim(.Fields("Ticker").Value)))
                            End If
                        End If

                        .MoveNext()
                    Loop Until .EOF
                End If
            End With


            Dim FullPath As String
            Dim sr As StreamReader
            Dim req As HttpWebRequest
            Dim res As HttpWebResponse


            X = InStr(AimControl.SYSQuoteUrl, "&Ticker")
            Part1 = Microsoft.VisualBasic.Left(AimControl.SYSQuoteUrl, X - 1)
            Part2 = Microsoft.VisualBasic.Right(AimControl.SYSQuoteUrl, Len(AimControl.SYSQuoteUrl) - (X + 7))
            FullPath = Part1 & Tck & Part2

            Try
            'new framework method
                req = CType(WebRequest.Create(FullPath), HttpWebRequest)
                res = CType(req.GetResponse(), HttpWebResponse)
                sr = New StreamReader(res.GetResponseStream(), System.Text.Encoding.ASCII)
                FinancialInformation = sr.ReadToEnd
                sr.Close()
            Catch ex As Exception
                MsgBox("Exception Httpwebrequest" & ex.Message)
                Exit Sub
            End Try

            If Len(FinancialInformation) = 0 Then
               ' somethin went wrong
            Else
               ' do something with the data downloaded into FinancialInformation
            End if

      End sub





Using VB.NET timer control
Top


VB.NET


' you'll need to add a timer control onto your form - vb.net places it below the form

' place this logic where you want to activate a timer event
' 1000 = 1 second, 60000 = 1 minute
  Timer1.Interval = 60000 * Val(TxtPortfolioMinutes.Text)
  Timer1.Enabled = True


' complete coding for the timer1 event

    Private Sub Timer1_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles Timer1.Tick
            ' time has elapsed, now do something!
            Timer2.Enabled = False ' temporarily shut off the timer
            GetFinancials()
            Timer2.Enabled = True

    End Sub




Using Dim global public static variables
Top


VB.NET


' Use static to retain value of a variable within a subroutine
Private Sub DoSomething
   Static NumRecords as Integer
End sub

' share usage of a variable
   Public InputActive As Boolean

' allow public use of a subroutine
Public Sub AllocateDatabase()

' allow public shared use of something
    Public Shared AIMWORKSPACE As DAO.Workspace

' the usage of the variable is limited to the form, subroutine or if statement
    Dim FormLoading As Boolean




Saving an arraylist using XML and then loading it back in
Top


VB.NET


' I tried so many things to store arraylist data in an MS Access database, 
' but, here is what I've found to be most reliable for me:
' One advantage I've noticed is freely being able to add new fields into the 
' arraylist without disturbing or a need for some type of data conversion.

I built a class that was compiled into a .dll file (sample) because arraylists are not easily directly updated. Each class member is then stored into an arraylist for adding or manipulation.

Imports System.ComponentModel
Imports System.Xml
Imports System.Xml.Serialization
Imports System.IO
Imports System.Text

' to serialize to xml and deserialize back use the serializable tag

 Public Class InvestmentData
    ' market quote

    Private MQSymbol As String
    Private MQINVID As Integer
     _
    Public Property Symbol() As String
        Get
            Return MQSymbol
        End Get
        Set(ByVal Value As String)
            MQSymbol = Value
        End Set
    End Property
  

   Public Sub New()
        ' Use a default name and total.
        MQHoldingName = "Unknown"
        MQSymbol = "?"
   
   end sub
'more stuff and properties
End Class

'
' with standard vb.net you'll need to edit the proj file for the class to
' build a dll (not supported) by setting the outputtype from winexe to library
' and the startupobject & 
' originatorkeyfile to spaces. Compile to dll then reference your class 
' from your app - for this example my dll is called "MQ"
'

'---------------------------------------------------------------
' Below code reads from an arraylist using structure
' which is then converted to XML for storing in MS Access
'---------------------------------------------------------------
        For Each Invclassrecord As MQ.InvestmentData In somearraylist
            XMLKey = Invclassrecord.InvID ' I store a unique key of the class
            XmlData = Invclassrecord.ToXmlString()
            ' do something with the data  -  for me i store into ms access
        next

' below function is within the above class referencing the investmentdata class
    Public Function ToXmlString() As String

        Dim oSerialize As New XmlSerializer(GetType(InvestmentData))
        Dim oBuffer As New MemoryStream

        oSerialize.Serialize(oBuffer, Me)
        Return ASCIIEncoding.ASCII.GetString(oBuffer.ToArray())

        oBuffer.Close()

    End Function


'---------------------------------------------------------------
' Below code reads from Access and deserializes into a structure
' which is then added into an arraylist - one array at a time
'---------------------------------------------------------------
                    Dim NewArrayLine As New MQ.InvestmentData

                    ' Use the Deserialize method to restore the object's state.
                    'inv = CType(serializer.Deserialize(reader), MQ.InvestmentData)

                    NewArrayLine = NewArrayLine.StoreMQFromXML(.Fields("MQData").Value)
                    AimControl.MQ.Data.Add(NewArrayLine)



    Public Function StoreMQFromXML(ByVal XMLDataToStore As String) As InvestmentData

        ' Create an instance of the XmlSerializer specifying type and namespace.
        ' Declare an object variable of the type to be deserialized.
        '  Dim inv As InvestmentData

        Dim serializer As New XmlSerializer(GetType(MQ.InvestmentData))

        Dim s As Char()
        s = XMLDataToStore.ToCharArray
        Dim b(s.Length - 1) As Byte
        Dim i As Integer
        For i = 0 To s.Length - 1
            b(i) = Convert.ToByte(s(i))
        Next

        ' A FileStream is needed to read the XML document.
        Dim oBuffer As New MemoryStream(b)
        Dim reader As New XmlTextReader(oBuffer)

        ' Use the Deserialize method to restore the object's state.
        Return serializer.Deserialize(reader)

        oBuffer.Close()
        reader.Close()
        b = Nothing

    End Function





Building a pop up display with a listview mousemove event
Top


VB.NET


' sample subroutine that traps mousemove over a listview called lvalerts
' the displayalertnumber routine actives a large size text box that floats
' depending on e.Y (vertical)

    Private Sub LvAlerts_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles LvAlerts.MouseMove

        If LvAlerts.Items.Count = 0 Then Exit Sub

        Dim lstitem As ListViewItem = LvAlerts.GetItemAt(e.X, e.Y)
        If lstitem Is Nothing Then
        Else
            DisplayAlertNumber(Val(lstitem.SubItems(2).Text), e.Y)
        End If

    End Sub



Build reusable dll component in vb.net standard
Top


VB.NET

build dll reusable component -

*right click project (.net proj) file using explorer and open with notepad
*change outputtype="WinExe" to outputtype="Library"
    also, startupobject from "form1" to ""
*complete a successful build
*in another project, reference the .dll file by using solution explorer
     select 'add reference', 'projects tab' and browse for the new .dll
     file to complete adding the component



VB.NET formats - directly from vb.net help
Top


VB.NET

The following lists the format characters for ms:format-date().

Character(s) Description 
M Months as 1-12 
MM Months as 01-12 
MMM Months as Jan-Dec 
MMMM Months as January-December 
d Days as 1-31 
dd Days as 01-31 
ddd Days as Sun-Sat 
dddd Days as Sunday-Saturday 
y Years as 1,2 �,99 
yy Years as 1900-9999 
yyyy Years as 1900-9999 
gg Period/era (ignored if there isn't one) 

The following lists the format characters for ms:format-time().

Character(s) Description 
h Hours as 0-12 
hh Hours as 00-12 
H Hours as 0-23 
HH Hours as 00-23 
m Minutes as 0-59 
mm Minutes as 00-59 
s Seconds as 0-59 
ss Seconds as 00-59 
tt Insert AM or PM, display hurs as 12-hour clock 
t Insert A or P, display hours as 12-hour clock 

The following table shows characters you can use to create user-defined 
date/time formats. Unlike in previous versions of Visual Basic, these format 
characters are case-sensitive

(:) Time separator. In some locales, other characters may be used to represent 
the time separator. The time separator separates hours, minutes, and seconds 
when time values are formatted. The actual character used as the time 
separator in formatted output is determined by your system's LocaleID value. 
(/) Date separator. In some locales, other characters may be used to represent 
the date separator. The date separator separates the day, month, and year when 
date values are formatted. The actual character used as the date separator in 
formatted output is determined by your locale. 
(%) Used to indicate that the following character should be read as a single-
letter format without regard to any trailing letters. Also used to indicate 
that a single-letter format is read as a user-defined format. See below for 
further details 
d Displays the day as a number without a leading zero (for example, 1). Use %d 
if this is the only character in your user-defined numeric format. 
dd Displays the day as a number with a leading zero (for example, 01). 
ddd Displays the day as an abbreviation (for example, Sun). 
dddd Displays the day as a full name (for example, Sunday). 
M Displays the month as a number without a leading zero (for example, January 
is represented as 1). Use %M if this is the only character in your user-
defined numeric format. 
MM Displays the month as a number with a leading zero (for example, 
01/12/01).  
MMM Displays the month as an abbreviation (for example, Jan). 
MMMM Displays the month as a full month name (for example, January). 
gg Displays the period/era string (for example, A.D.) 
h Displays the hour as a number without leading zeros using the 12-hour clock 
(for example, 1:15:15 PM). Use %h if this is the only character in your user-
defined numeric format. 
hh Displays the hour as a number with leading zeros using the 12-hour clock 
(for example, 01:15:15 PM). 
H Displays the hour as a number without leading zeros using the 24-hour clock 
(for example, 1:15:15). Use %H if this is the only character in your user-
defined numeric format. 
HH Displays the hour as a number with leading zeros using the 24-hour clock 
(for example, 01:15:15). 
m Displays the minute as a number without leading zeros (for example, 
12:1:15). Use %m if this is the only character in your user-defined numeric 
format. 
mm Displays the minute as a number with leading zeros (for example, 12:01:15). 
s Displays the second as a number without leading zeros (for example, 
12:15:5). Use %s if this is the only character in your user-defined numeric 
format. 
ss Displays the second as a number with leading zeros (for example, 12:15:05). 
F Displays fractions of seconds. For example ff will display hundredths of 
seconds, whereas ffff will display ten-thousandths of seconds. You may use up 
to seven f symbols in your user-defined format. Use %f if this is the only 
character in your user-defined numeric format.  
T Uses the 12-hour clock and displays an uppercase A for any hour before noon; 
displays an uppercase P for any hour between noon and 11:59 P.M. Use %t if 
this is the only character in your user-defined numeric format. 
tt Uses the 12-hour clock and displays an uppercase AM with any hour before 
noon; displays an uppercase PM with any hour between noon and 11:59 P.M. 
y Displays the year number (0-9) without leading zeros. Use %y if this is the 
only character in your user-defined numeric format. 
yy Displays the year in two-digit numeric format with a leading zero, if 
applicable.  
yyy Displays the year in four digit numeric format. 
yyyy Displays the year in four digit numeric format. 
z Displays the timezone offset without a leading zero (for example, -8). Use %z if this is the only character in your user-defined numeric format. 
zz Displays the timezone offset with a leading zero (for example, -08) 
zzz Displays the full timezone offset (for example, -08:00) 

The following table identifies characters you can use to create user-defined 
number formats. These may be used to build the style argument for the Format 
function:

Character Description 
None Displays the number with no formatting. 
(0) Digit placeholder. Displays a digit or a zero. If the expression has a 
digit in the position where the zero appears in the format string, display it; 
otherwise, displays a zero in that position. 
If the number has fewer digits than there are zeros (on either side of the 
decimal) in the format expression, displays leading or trailing zeros. If the 
number has more digits to the right of the decimal separator than there are 
zeros to the right of the decimal separator in the format expression, rounds 
the number to as many decimal places as there are zeros. If the number has 
more digits to the left of the decimal separator than there are zeros to the 
left of the decimal separator in the format expression, displays the extra 
digits without modification.
 
(#) Digit placeholder. Displays a digit or nothing. If the expression has a 
digit in the position where the # character appears in the format string, 
displays it; otherwise, displays nothing in that position. 
This symbol works like the 0 digit placeholder, except that leading and 
trailing zeros aren't displayed if the number has fewer digits than there are 
# characters on either side of the decimal separator in the format expression. 

 
(.) Decimal placeholder. The decimal placeholder determines how many digits 
are displayed to the left and right of the decimal separator. If the format 
expression contains only # characters to the left of this symbol; numbers 
smaller than 1 begin with a decimal separator. To display a leading zero 
displayed with fractional numbers, use zero as the first digit placeholder to 
the left of the decimal separator. In some locales, a comma is used as the 
decimal separator. The actual character used as a decimal placeholder in the 
formatted output depends on the number format recognized by your system. Thus, 
You should use the period as the decimal placeholder in your formats even if 
you are in a locale that uses a comma as a decimal placeholder. The formatted 
string will appear in the format correct for the locale. 

(%) Percent placeholder. Multiplies the expression by 100. The percent 
character (%) is inserted in the position where it appears in the format 
string. 
(,) Thousand separator. The thousand separator separates thousands from 
hundreds within a number that has four or more places to the left of the 
decimal separator. Standard use of the thousand separator is specified if the 
format contains a thousand separator surrounded by digit placeholders (0 or 
#). A thousand separator immediately to the left of the decimal separator 
(whether or not a decimal is specified) or as the rightmost character in the 
string means "scale the number by dividing it by 1,000, rounding as needed." 

For example, you can use the format string "##0,." to represent 100 million as 
100,000. Numbers smaller than 1,000 but greater or equal to 500 are displayed 
as 1, and numbers smaller than 500 are displayed as 0. Two adjacent thousand 
separators in this position scale by a factor of 1 million, and an additional 
factor of 1,000 for each additional separator. 

Multiple separators in any position other than immediately to the left of the 
decimal separator or the rightmost position in the string are treated simply 
as specifying the use of a thousand separator. In some locales, a period is 
used as a thousand separator. The actual character used as the thousand 
separator in the formatted output depends on the Number Format recognized by 
your system. Thus, You should use the comma as the thousand separator in your 
formats even if you are in a locale that uses a period as a thousand 
separator. The formatted string will appear in the format correct for the 
locale.
 
(:) Time separator. In some locales, other characters may be used to represent 
the time separator. The time separator separates hours, minutes, and seconds 
when time values are formatted. The actual character used as the time 
separator in formatted output is determined by your system settings. 

(/) Date separator. In some locales, other characters may be used to represent 
the date separator. The date separator separates the day, month, and year when 
date values are formatted. The actual character used as the date separator in 
formatted output is determined by your system settings. 
(E- E+ e- e+) Scientific format. If the format expression contains at least 
one digit placeholder (0 or #) to the left of E-, E+, e-, or e+, the number is 
displayed in scientific format and E or e is inserted between the number and 
its exponent. The number of digit placeholders to the left determines the 
number of digits in the exponent. Use E- or e- to place a minus sign next to 
negative exponents. Use E+ or e+ to place a minus sign next to negative 
exponents and a plus sign next to positive exponents. You must also include 
digit placeholders to the right of this symbol to get correct formatting. 
- + $ ( ) Literal characters. These characters are displayed exactly as typed 
in the format string. To display a character other than one of those listed, 
precede it with a backslash (\) or enclose it in double quotation marks (" "). 
(\) Displays the next character in the format string. To display a character 
that has special meaning as a literal character, precede it with a backslash 
(\). The backslash itself isn't displayed. Using a backslash is the same as 
enclosing the next character in double quotation marks. To display a 
backslash, use two backslashes (\\). 
Examples of characters that can't be displayed as literal characters are the 
date-formatting and time-formatting characters (a, c, d, h, m, n, p, q, s, t, 
w, y, /, and :), the numeric-formatting characters (#, 0, %, E, e, comma, and 
period), and the string-formatting characters (@, &, <, >, and !).

 
("ABC") Displays the string inside the double quotation marks (" "). To 
include a string in the style argument from within code, you must use Chr(34) 
to enclose the text (34 is the character code for a quotation mark (")). 






VISTA ERROR - Run time error '5922' Word was unable to open datasource
Top


VB.NET

Vista machine with both MS word 97 and MS Word 2000
On Vista machine program bllstmt.exe compiled with VB 5.0 on VISTA machine, works good on XP

MS Word 97 upon opening always had macro storage error 
MS Word 2000 upon opening now has the 5922 unable to open error
MS Word when pressing ALT F11, then showing references has:
       vb for applications
       ole automation
       normal
       microsoft office 9.0 object library

Above works on XP but not on VISTA machine
Above works on VISTA but with Word 2007 for VISTA (not purchasing sorry MSFT!)



Set oDoc = oApp.Documents.Open(FullProgramPath, False, True)
    
With oDoc.MailMerge
        
'Set up the mail merge type as mailing labels and use
'a tab-delimited text file as the data source.

    .MainDocumentType = wdFormLetters
    .OpenDataSource (FullMergePath)  <<<<==== FAILING HERE WITH DEBUG ON
                 
    If DeliveryType = "Email" Then
        .Destination = wdSendToEmail
        .MailAddressFieldName = "Email_address"
        .MailAsAttachment = True
        .MailSubject = SYSCYCLESELECTED
        .SuppressBlankLines = True
    ElseIf DeliveryType = "Fax" Then
        .Destination = wdSendToFax
        .MailAddressFieldName = "Fax_phone_number"
        .SuppressBlankLines = True
    Else
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
    End If

    .Execute
    

End With


In my case several items were attempted. What I had believed the fix for my 
problem was both usage of "Select method" when setting up the .txt merge mail 
information and selecting text driver vs. odbdc driver, AND, fix my column 
headings which previously had spaces and now match the field names 
being used in the document exactly: "Customer Name" vs. what it looks like 
now "Customer_Name". Spaces are not supported in newer versions of word. I 
believe the misleading error message was a result of field names being 
mismatched. This worked on one of my vista machines but not on another. Something is telling me it is the OS now, as of 10/3/08 I'm not sure what is happening; some type of vista security is not permitting this action.

WARNING - be attentive when re-assigning the datasource there is a little tiny 
checkbox when browsing for your datasource that you'll need to click "SELECT 
METHOD"


please reference Microsoft website for fix or just read below

http://msdn.microsoft.com/en-us/library/aa140183.aspx

Text Files

Delimited text and comma-separated value files are standard data formats. 
Almost any program that imports and exports data supports one or both, be it a 
Windows, DOS, or mainframe application. Up through Word 95, using text files 
as a data source was a fairly straightforward proposition. 

But if you're merging in Office 97 (and on Office 2000 machines upgraded from 
an earlier version), you're likely to run into a number of problems: The 
individual fields aren't recognized, the names all run together as a single 
field, and error messages like "Word was unable to open the data source" 
appear. The culprit is the text ODBC driver with which Word does not 
communicate correctly. To link up to your data source, you have three options: 


1)        uninstall the ODBC driver; 

2)        activate the Select method checkbox so you can specify Word's 
internal text file converter as the link method (see FIGURE 1); 

3)        rename the file with an extension the ODBC driver doesn't recognize 
(such as .dat), so that Word automatically uses its internal text file 
converter. 

"Virgin" Office 2000 installations shouldn't have this problem, as Microsoft 
didn't include the Text ODBC converter as one of the recognized link methods. 

If you use a Header file to define the field names for the data source (as is 
often the case with data coming from a mainframe), an annoying automation 
obstacle you'll encounter in all versions of Word is a dialog box requesting 
you to confirm the field and record delimiters. For this, too, there are a 
couple of work-arounds: 


1)        Create the Header file as a Word table, or

2)        duplicate the first line of the Header file, so that it contains two 
lines with the same number of fields using the same field delimiter (Note: 
This only works for field delimiters, not for record delimiters.): 

FirstName~LastName~Address~City~PostalCode
FirstName~LastName~Address~City~PostalCodeText files created with non-ANSI 
character sets present a problem. Word will open them for mail merge 
automatically, without recognizing their origin or giving you the opportunity 
to convert them. For a DOS file, with ASCII Code Page encoding, you could get 
something like this: 

Vous ^tes all,s ... Bfle. instead of: 

Vous �tes all�s � B�le. Looking at the OpenDataSource method of the MailMerge 
object, you may notice the Format argument and think this provides a way out. 
Unfortunately, it's generally ignored by Word, even if you use one of the 
built-in constants. What does work is opening the document manually in Word. 
With Tools | Options | General | Confirm conversion at open activated, select 
the correct conversion filter, and save it as a Word document for use as the 
data source. However, there is no ideal way to automate this. Again, in the 
Open method, Word provides no way to specify the correct converter. You have 
to rely on SendKeys to make the proper selection, and confirm it in the 
Confirm Conversions dialog box: 


szFileName = "E:\My Documents\Mergdata.txt" Options.ConfirmConversions = True
SendKeys "^{HOME}MS-DOS Text{ENTER}" 
Set doc = Documents.Open(FileName:=szFileName) 
doc.SaveAs Left(szFileName, Len(szFileName) - 3) & "doc" 



To contact me, please (Author of this website) E-mail me at:
jep1965@gmail.com

This page last updated August 28 2008

Counter







Hosted by www.Geocities.ws

1