Index of topics on this page
VB.NET
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 - 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
ERROR HANDLING - Error handling in VB.NET
Word merge and Visual basic 5.0
VB interface with MS word utilizing merge features
For help on building a MS word document with merged data click here for my instructions
{ IF {MERGEFIELD Tax_applied} = "" " " "Taxes applied" \* MERGEFORMAT}
Visual Basic 5.0
Determining operating system
Visual Basic .Net
PROBLEM - Visual Basic .Net Specified cast is not valid
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
Top
' 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
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
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
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
VB.NET
Start a new form from base form in VB.NET
Top
VB.NET
Error handling in VB.NET
VB.NET
Screen coordinate calculation in VB.NET
VB.NET
Setting control color in VB.NET
VB.NET
Tab control event in VB.NET
VB.NET
Simple sleep event in VB.NET
VB.NET
Writing to the Framework event application log in VB.NET
VB.NET
Using the listview control in VB.NET
VB.NET
Reading MS ACCESS schema including tables, columns and foreign keys in VB.NET
This code has been taken from my adodbrpt report generator project.
Visual basic
Limiting the number of running instances of your application in Visual Basic
Visual basic
Create hexadecimal date serial numbers
Visual basic
Compressing and uncompressing data - LZW and old Quick Basic
VB.NET
Sample code showing a bubble sort
Determine system directory with and without using windows API
Visual Basic 4, 5, 6 and VB.NET
Build dynamic control indexed arrays in VB.NET
Trapping keypress events in VB.NET
Trapping mouse wheel events in VB.NET
Distributing .exe software using VB.NET
You do not have a license to use this ActiveX control VB.NET
PRB: Error "Unrecognized Database Format" When You Upgrade to Access 2000 or 2002 VB.NET
Structures and arraylist in VB.NET are great tools to use!
Building pie or bar charts in VB.NET
Loading a bitmap into a picture box at run time
Using VB.NET internet download capabilities
Using VB.NET timer control
Using Dim global public static variables
Saving an arraylist using XML and then loading it back in
Building a pop up display with a listview mousemove event
Build reusable dll component in vb.net standard
VB.NET formats - directly from vb.net help
VISTA ERROR - Run time error '5922' Word was unable to open datasource
To contact me, please (Author of this website) E-mail me at:
This page last updated August 28 2008
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
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
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")
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()
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
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
Top
System.Threading.Thread.Sleep(8000)
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
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
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
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()
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
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
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
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
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)
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
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.
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
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.
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.
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
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 .....
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
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"
'
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
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
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
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
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
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
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 (")).
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"
jep1965@gmail.com