i.e.Logical.Solutions VB / VBA Library

~cs_ImpExp
~cs_modAddErrHandlers
~cs_modCDO
~cs_modCommDialog
~cs_modDebugTests
~cs_modWin32APICalls
cs_modAutomation
cs_modDateOps
cs_modExtern
cs_modFileIO
cs_modFormOps
cs_modMathOps
cs_modRefreshTableLinks
cs_modStringOps
cs_modTableOps

~cs_ImpExp

ExportCS_Text

Public Sub ExportCS_Text()

' export module as Text for application Import

ExportCStoDB

Public Sub ExportCStoDB()

' copy the modules from common stuff to the external database

GetCSPath

Private Function GetCSPath()

ImportCS_Text

Public Sub ImportCS_Text()

' import module as Text for application

ImportFromCS

Public Sub ImportFromCS()

' copy the modules from common stuff to this database

' Common Stuff should be a Library Database otherwise we will not be able to find this code

RemoveCSRef

Public Sub RemoveCSRef()

SaveCSPath

Private Sub SaveCSPath()

SetRefToCS

Public Sub SetRefToCS()

' delete Common Stuff modules and set reference to common stuff database

Module List (Top)

~cs_modAddErrHandlers

AddMissingErrHandlers

Public Sub AddMissingErrHandlers(lngScanOnly As Long)

' adds missing error handling to modules, forms and reports

' used to clean up poorly written applications

emailProblemReport

Public Sub emailProblemReport(Optional lngErr As Long, Optional strProc As String, _

Optional strErrSource As String, Optional strModName As String)

' email developer with problem

' !!!! DO NOT RENAME THIS PROCEDURE

ErrMsgLines

Private Function ErrMsgLines(lngLines As Long) As String

' return the formatted string for the error handlers

InsertErrorHandler

Public Function InsertErrorHandler()

' fill in an error handler on a module

' run form ^+e from AutoKeys Macro (ugh)

InsertModuleName

Public Function InsertModuleName(Optional strModName As String = "")

' insert the module name into the module if it does not exist

InsertModuleNames

Public Sub InsertModuleNames()

' insert the module name for all modules

ParseModule

Sub ParseModule(strModName As String, lngScan As Long)

' parses the passed module and checks to see if On Error exists

' Warn if On Error Resume Next

' no Error Handler because we run interactivley

' if lngScan then we do not add to modules, just check

ParseModuleName

Public Function ParseModuleName(strLine As String, strType As String) As String

' gets the module name from the string line

ReplaceDimProcName

Public Sub ReplaceDimProcName(strModule As String)

' remove the lines Dim Procname

' replace procname = with kProcName

ReplaceDimProcNames

Public Sub ReplaceDimProcNames()

' insert the module name for all modules

ReplaceErrHandler

Public Function ReplaceErrHandler(mdl As Module, lngLine As Long, strErrLabel As String, _

strType As String, strParent As String) As String

' replace a non standard error message with our standard Select Case Err type

ReplaceErrMsgLine

Public Sub ReplaceErrMsgLine(strModule As String)

'replace the error message lines with our standard format lines

ReplaceErrMsgLines

Public Sub ReplaceErrMsgLines()

' insert the module name for all modules

ReportCS_ModuleProcs

Public Sub ReportCS_ModuleProcs()

' creates table of CS_mod Procedure names and first comment lines

ReportModuleProcs

Public Sub ReportModuleProcs()

' creates table of Procedure names and first comment lines

' reports for modules, forms and reports

Module List (Top)

~cs_modCDO

CreateEmailMsg

Public Sub CreateEmailMsg(strRecipient As String, ByVal strText As String, strSubject As String)

' create an email message. Recipient should be already resolved

StartMessagingAndLogon

Public Function StartMessagingAndLogon() As MAPI.Session

' connect to MAPI provider

Module List (Top)

~cs_modCommDialog

FindData

Public Function FindData(strSearchPath, strTitle As String, strInitFile As String, _

ParamArray varFilt() As Variant) As String

MSA_ConvertFilterString

Function MSA_ConvertFilterString(strFilterIn As String) As String

' Creates a filter string from a bar ("|") separated string.

' The string should pairs of filter|extension strings, i.e. "Access Databases|*.mdb|All Files|*.*"

' If no extensions exists for the last filter pair, *.* is added.

' This code will ignore any empty strings, i.e. "||" pairs.

' Returns "" if the strings passed in is empty.

MSA_CreateFilterString

Function MSA_CreateFilterString(varFilt() As Variant) As String

' Creates a filter string from the passed in arguments.

' Returns "" if no argumentss are passed in.

' Expects an even number of arguments (filter name, extension), but

' if an odd number is passed in, it appends "*.*".

MSA_GetOpenFileName

Private Function MSA_GetOpenFileName(msaof As MSA_OPENFILENAME) As Integer

' Opens the Open dialog.

MSA_GetSaveFileName

Private Function MSA_GetSaveFileName(msaof As MSA_OPENFILENAME) As Integer

' Opens the file save dialog.

MSA_SimpleGetOpenFileName

Function MSA_SimpleGetOpenFileName() As String

' Opens the Open dialog with default values.

MSA_SimpleGetSaveFileName

Function MSA_SimpleGetSaveFileName() As String

' Opens the file save dialog with default values.

MSAOF_to_OF

Private Sub MSAOF_to_OF(msaof As MSA_OPENFILENAME, of As OPENFILENAME)

' This sub converts from the Microsoft Access structure to the Win32 structure.

OF_to_MSAOF

Private Sub OF_to_MSAOF(of As OPENFILENAME, msaof As MSA_OPENFILENAME)

' This sub converts from the Win32 structure to the Microsoft Access structure.

Module List (Top)

~cs_modDebugTests

DocumentModified

Sub DocumentModified()

dtest

Public Sub dtest()

' used to test subroutines

IndexList

Public Function IndexList()

' list indexes on table

QueryDefX

Public Function QueryDefX()

QueryRowCount

Public Function QueryRowCount(qName As String) As Long

' returns the number of records in an open query

SleepTest

Sub SleepTest(strHMS As String, dblCount As Double)

SptoDash

Public Function SptoDash(partNo As String)

TableDefX

Function TableDefX()

testReportName

Public Sub testReportName()

Module List (Top)

~cs_modWin32APICalls

FindWindow

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, _

ByVal lpWindowName As String) As Long

GetAsyncKeyState

Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

GetClassName

Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd _

As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

GetDesktopWindow

Public Declare Function GetDesktopWindow Lib "user32" () As Long

GetFocus

Public Declare Function GetFocus Lib "user32" () As Long

GetVersionEx

Public Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO) As Long

GetWindowText

Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, _

ByVal lpString As String, ByVal cch As Long) As Long

QueryValue

Public Function QueryValue(sKeyName As String, sValueName As String)

QueryValueEx

Public Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long

RegDeleteKey

Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, _

ByVal lpSubKey As String) As Long

RegQueryValueEx

Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, _

ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long

RegQueryValueExNULL

Public Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, _

ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long

RegQueryValueExString

Public Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, _

ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long

RegSetValueEx

Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, _

ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long

RegSetValueExLong

Public Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, _

ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long

SetValueEx

Public Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long

WNetCancelConnection2

Public Declare Function WNetCancelConnection2 Lib "mpr.dll" Alias "WNetCancelConnection2A" (ByVal lpName As String, _

ByVal dwFlags As Long, ByVal fForce As Long) As Long

WNetGetLastError

Public Declare Function WNetGetLastError Lib "mpr.dll" Alias "WNetGetLastErrorA" (lpError As Long, _

ByVal lpErrorBuf As String, ByVal nErrorBufSize As Long, ByVal lpNameBuf As String, ByVal nNameBufSize As Long) As Long

Module List (Top)

cs_modAutomation

CheckSharedTool

Public Function CheckSharedTool(strTool As String) As Boolean

' check to see if the required ocx is installed

SetDataSrc

Public Function SetDataSrc(ByVal strWordDoc As String) As String

' set the global variable for the Word merge doc data source

ShowApp

Public Function ShowApp(ByVal strAppName As String) As Long

' use Win32 API to show app so user does not open umpteen copies

' shows the application name passed

Module List (Top)

cs_modDateOps

CheckAllAutoReports

Public Sub CheckAllAutoReports()

' auto run reports based on frequency and last run date

' strFilterFld is a filter field that we build the filter string from if not ""

' intRange is range over which to run query. if False between last run and today

CheckAutoReport

Public Sub CheckAutoReport(strRptName As String, ByVal strFilterFld As String, strFreq As String, intRange As Integer)

' auto run reports based on frequency and last run date

' strFilterFld is a filter field that we build the filter string from if not ""

' intRange is range over which to run query. if False between last run and today

CheckAutoUser

Public Sub CheckAutoUser(lngMode As Long)

' check to see if the _OttoMan user is logged in

' set User to _OttoMan if no one or more thatn 24 hours since last user

' lngMode is true to Login, false to Logout

' if we are _ottoman user, then we clear our name when close

CheckDate

Public Function CheckDate(dChk As Date)

' check to see if passed date is past today

' returns false if date is gt today

CheckExpiry

Public Sub CheckExpiry()

' checks to see if an expiry date is set and puts up msg box if it is

CheckLogOff

Public Function CheckLogOff(strFormName As String, strCaption) As Boolean

' check to see if backup about to run

checkMinDate

Public Function checkMinDate(Optional yy, Optional mm, Optional dd, Optional disp) As Boolean

ChkDaily

Public Function ChkDaily(strRecName As String) As Boolean

' checks to see if something has been run this week

'strRecName is rec to check in System Variables

ChkMonthly

Public Function ChkMonthly(strRecName As String) As Boolean

' checks to see if something has been run this month on the Day of the Month

'strRecName is rec to check in System Variables

ChkWeekly

Public Function ChkWeekly(strRecName As String) As Boolean

' checks to see if something has been run this week

'strRecName is rec to check in System Variables

ChkYearly

Public Function ChkYearly(strRecName As String) As Boolean

' checks to see if something has been run this month on the Day of the Month

'strRecName is rec to check in System Variables

DateRange

Public Function DateRange() As String

' returns a date range as a string

DateStart

Public Function DateStart() As Date

' returns a date Start as a string

DateStop

Public Function DateStop() As Date

' returns a date Stop as a string

DayOfYear

Public Function DayOfYear(varDate As Date) As Integer

' returns day of year for date passed

DevSys

Public Function DevSys() As Boolean

EndofMonth

Public Function EndofMonth(yy, mm)

EndOfWorkWeek

Public Function EndOfWorkWeek(varDate As Date) As Date

' reports the end of the last complete work week

' if vardate is Saturday, then vardate else Saturday of last week

HrMin

Public Function HrMin(varTimeDiff As Variant) As String

' returns HH:MM, varTimeDiff is fraction of a day

IsLeapYear

Public Function IsLeapYear(intyear As Integer) As Boolean

LastMonthStart

Public Function LastMonthStart(rptDate As Date)

' rptdate is normally the current date and we calculate the first of last month

' if rptdate is not the date then the first of the month sent

LastMonthStop

Public Function LastMonthStop(rptDate As Date)

' rptdate is normally the current date and we calculate the end of last month

' if rptdate is not the date then the end of the month sent

LastQtrStart

Public Function LastQtrStart()

' returns the last quarter dates for today

LastQtrStop

Public Function LastQtrStop()

' returns the last quarter dates for today

MonthList

Public Function MonthList(dblAhead As Integer, dblBack As Integer, varDate As Date) As String

' builds a list of months for a list box from a pass ahead and back date

MonthText

Public Function MonthText(ByVal intMonth As Integer, intShort As Integer) As String

' returns the Text of a month passed

' if intshort is true then only left 3 chars

PrevWorkDate

Public Function PrevWorkDate(varDate As Date) As Date

'returns previous workweek date, does not account for holidays

ReportMinDate

Public Function ReportMinDate() As Date

' reports the minimum system date

SetExpiry

Public Sub SetExpiry(varExpDate As Date)

'sets expiry date n days from now

SetWeekDayDate

Public Function SetWeekDayDate(varDate As Date, strDay As String) As Date

' set date to day of the Current Week for the date passed and the day passed

' if day is later than day passed it is the date of the prev Day

' if day is today then today is set

Sleep

Public Sub Sleep(strHMS As String, ByVal dblCount As Double)

' wait for x time

WeekOfYear

Public Function WeekOfYear(varDate As Date) As Long

' returns the week for the passed date

' week is based on ending on a Saturday.

' if 1/1/yy is Saturday, then 1/1 is week 1 and 1/2 is week 2

Module List (Top)

cs_modExtern

checkExtern

Public Function checkExtern(xDb As Database, tName As String)

' check to see if we have our table in an external database

checkLocal

Public Function checkLocal(tName As String)

' check to see if we have our table linked locally

' or data is on a server

CreateRelation

Public Function CreateRelation(xDb As Database, strPrimTbl As String, strPriKey As String, _

strFrgnTbl As String, strFKey As String, lngFlags As Long) As Boolean

' create a relation ship between tables

' pass relation attributes in lngFlags

LinkToExtern

Public Function LinkToExtern() As String

' opens the linked database as an external database

ReportDataPath

Public Function ReportDataPath() As String

' reports the data location for the application

Module List (Top)

cs_modFileIO

ExportCS_HTML

Public Sub ExportCS_HTML(Optional strOutFile As String = "", Optional strTable As String = "_tempRMP")

' export module headers as HTML for Web upload

' used to create this document

ReadWrINI

Public Function ReadWrINI(fName As String, fSect As String, fVal As String, fData As String, IO As Integer) As String

' OBSOLETE - use Win32 API calls to read registry other than VB and VBA hive

' read data from an ini file.

' we have to use this because registry crashes under MDE

' ini file has to exist and have the correct section or nothing will be returned

' ini file has to reside in current directory

Module List (Top)

cs_modFormOps

BlankForm

Public Sub BlankForm(fName As String)

'clears all the text box fields on a form

CheckDirty

Public Function CheckDirty(fName As String)

' checks to see if a form is dirty and returns true to exit function

' true means user does not want to lose changes

FindRec

Public Sub FindRec(FindString As String)

' finds the record matching the string passed

GetSetFontData

Public Function GetSetFontData(GetSet As Integer, fontName As String) As String

' gets or sets ???Font data in table 1

' set is true, get is false

' returns fontname & vbtab & fontsize & bold & vbtab & underline & vbtab & italid

IsFormOpen

Public Function IsFormOpen(frmName) As Boolean

' returns true if form is open

ListProperties

Public Sub ListProperties(obj As Object)

' list the properties for the passes object

LockPrevCtl

Public Sub LockPrevCtl()

' used to lock the previous control

' usually on LostFocus event after unlock

MoveNewRec

Public Sub MoveNewRec(frmName As String)

' goes to a new record on the form name

ReportFormReturnButton

Public Function ReportFormReturnButton() As String

' reports the return string from custom forms

'OBSOLETE - use properties and methods

SetLockedColor

Public Sub SetLockedColor(lngFore As Long, lngBack As Long)

' set locked to our colors

SetUnLockedColor

Public Sub SetUnLockedColor(lngFore As Long, lngBack As Long, lngType As Long)

' set UNlocked to our colors

UnLockCurrCtl

Public Sub UnLockCurrCtl()

' used to unlock the current control

' usually on DblClick event

Module List (Top)

cs_modMathOps

FieldMath

Public Function FieldMath(tbl As String, fld As String, oldVal As Integer, newVal As Integer, whClause As String)

' does math on a field in a table

RoundUp

Public Function RoundUp(Nbr As Double, Rmdr As Double)

' if there is any decimal part to Nbr then returns to next number

StrToNum

Public Function StrToNum(strNum As String) As Currency

' converts string to number by removing punctuation

' uses first two differing delimiters to set the string to parse

Module List (Top)

cs_modRefreshTableLinks

CheckLinks

Public Function CheckLinks() As Boolean

' Check links to the ies_data database; returns True if links are OK.

RefreshLinks

Private Function RefreshLinks(strFileName As String) As Boolean

' Refresh links to the supplied database. Return True if successful.

RelinkTables

Public Function RelinkTables() As Boolean

' Tries to refresh the links to the database.

' Returns True if successful.

Module List (Top)

cs_modStringOps

BuildAddr

Public Function BuildAddr(Optional strAddr As String, Optional strCity As String, _

Optional strST As String, Optional strZip As String, Optional strCountry As String, _

Optional intLines As Integer) As String

CapFirst

Public Function CapFirst(ByVal strIn, strDelims As String) As String

' similar to propercase but does not make C.s. Forrester for C.S. Forrester

' any char after a delim is converted to upper case

CapKey

Public Sub CapKey(KeyAscii As Integer)

' returns upper case of letter keys

' use in keypress event in forms

CheckApostrophe

Public Sub CheckApostrophe(strName As String)

' converts appostrophe to ? in strname

DelimChange

Public Function DelimChange(dStr As String, DeLims As String, dLim As String) As Integer

' converts delimiters DeLims in DStr to DLim

ExtChange

Public Function ExtChange(ByVal strFileName As String, strNewExt As String) As String

' creates strFileName.strNewExt from strFileName

ExtractString

Public Function ExtractString(ByVal strSrc As String, ByVal lngCnt As Long, _

str1 As String, str2 As String, lngCaseSens As Long) As String

' extract a string from another string between two strings as delimiters

' useful for HTML processing

GetFileExt

Public Function GetFileExt(strFileName As String) As String

' returns the extendsion of file, including the .

GetPath

Public Function GetPath(strPath As String) As String

' return a file name from a full path

MaxofStrNum

Public Function MaxofStrNum(strTable As String, strField As String)

' get the maximum number value of a text number field on a table

NoSpaces

Public Function NoSpaces(ByVal strIn) As String

' remove any spaces from a string

PathTermChg

Public Function PathTermChg(strPath As String)

' add a \ to the end of a path if missing

Quote

Public Function Quote(ByVal str As String) As String

' add quote marks around a string

ReplaceWord

Public Function ReplaceWord(strW As String, strRep As String, strNew As String, intWdNum)

' replaces strRep in strW with strNew

' returns original string if strRep is not found

' intWdNum is the word to replace or true to do all

TrimDLim

Public Sub TrimDLim(dStr As String, dLim As String)

' like trim which removes extra spaces from the ends of strings, we remove extra dLim

WordCount

Public Function WordCount(ByVal strW As String, dLim As String) As Long

' counts the words in strW based on dLim

' returns a long of the number of words

WordExtract

Public Function WordExtract(ByVal strW As String, strDeLim As String, lngNum As Long) As String

' extracts the Nth word from strW based on strDeLim

' returns "" if not enough words

' two delimiters together counts as a word and is not returned.

' two delimiters together reduce the count of words in the string

Module List (Top)

cs_modTableOps

AddField

Public Function AddField(xDb As Database, strTblName As String, strFldName As String, _

lngFldType As Long, intFldSize As Integer, intErrMsg As Integer) As Boolean

' add a new Field to a database

AddTable

Public Function AddTable(xDb As Database, strTblName As String, strKeyName As String, _

lngKeyType As Long, intKeySize As Integer, intErrMsg As Integer) As Boolean

' add a new table to a database

' intErrMsg is set to false to bypass error message

BuildXrefTbl

Public Sub BuildXrefTbl(tbl As String, IdFld As String, DataFld As String, XrefID As Variant, NoXref As String, dLims As String, dLim As String)

' Table is name of source data table. Builds "Tbl Xref"

' IdField is name of Record Key Field

' XrefFld is the field to Xref into "Xref XrefFld"

' dLims are characters that are not xref'd

' dlim is the character to use to find the words

' NoExref is a list of words that are not Xrefd

CheckUpdate

Public Function CheckUpdate() As Boolean

' checks for an update.mdb in datapath

ChgFieldDefault

Public Function ChgFieldDefault(db As Database, strTable As String, strField As String, _

strDefault As String, intErrMsg As Integer) As Boolean

' change default for table field.

ChgFieldRequired

Public Function ChgFieldRequired(db As Database, strTable As String, strField As String, _

boolRequired As Boolean, intErrMsg As Integer) As Boolean

' change Required for table field.

ChgFieldZeroLen

Public Function ChgFieldZeroLen(db As Database, strTable As String, strField As String, _

boolZeroLen As Boolean, intErrMsg As Integer) As Boolean

' change ZeroLen for table field.

CreateLocalQueryDef

Public Sub CreateLocalQueryDef(strName As String, strQry As String)

' create a generic query on a table

CreateLocalTableDef

Public Sub CreateLocalTableDef(strName As String)

' create a local table def on an external table

DeleteField

Public Function DeleteField(xDb As Database, strTblName As String, strFldName As String, _

intErrMsg As Integer) As Boolean

' Delete a new Field to a database

DeleteTable

Public Function DeleteTable(xDb As Database, strTblName As String, intErrMsg As Integer) As Boolean

' Delete a new table to a database

FixCase

Public Sub FixCase(strTable As String, strFld As String, lngCase As Long)

' update the Table to passed Case

GetAppString

Public Function GetAppString(strData As String) As String

' returns _Data****** string from table 1

GetData

Public Function GetData(tbl As String, colID As String, rec As String, colm As String) As String

' reads data from a record in the tbl file

Increment_Data

Public Function Increment_Data(tbl As String, colID As String, rec As String, _

colm As String, lngCnt As Long)

' increments a record in the tbl file

' if the record is not found then adds record

Increment_NumID

Public Function Increment_NumID(tbl As String, colID As String, RecId As Long, _

colm As String, dblCnt As Double)

' increments a record in the tbl file

' if the record is not found then adds record

IsItMDE

Function IsItMDE(dbs As Database) As Boolean

' return if mde file

IsLocal

Public Function IsLocal() As Integer

' check to see if data on system machine

MakeFieldName

Public Sub MakeFieldName(strField As String)

' converts spaces and . to _

NetDir

Public Function NetDir(strMask As String) As String

' returns a directory of a networked drive

ReportCurrDBName

Public Function ReportCurrDBName() As String

' reports the name of the current NOT Code db

TestRecSet

Function TestRecSet(tName, rec, iName)

UpdateData

Public Function UpdateData(tbl As String, colID As String, rec As String, colm As String, dval As String) As Boolean

' updates a record in the tbl file

' if the record is not found then adds record

ViewWhatsNew

Public Sub ViewWhatsNew(intForce As Integer)

' if intForce is true then show what's new

Module List (Top)