-
May 31st, 2005, 12:23 AM
#1
Frequently Asked VB Questions
In order to make this thread as tidy as possible pls. PM me all your comments, suggestions, improvements, modifications.... And pls. post only those that are only truly "Frequently Asked Questions".... Thanks!
1. How to read/write ini?
VB Code:
Option Explicit 'declares for ini controlling Private Declare Function GetPrivateProfileSection Lib "kernel32" Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long Private Declare Function WritePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpString As String, ByVal lpFileName As String) As Long Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long Private Sub Form_Load() On Error Resume Next Dim File As String, OFLen As Double, Str As String File = "C:\temp.txt" OFLen = FileLen(File) 'write few example sections: WriteIniSection File, "Test1", "" WriteIniSection File, "Test2", "Here shoud be found some text" 'write few ini strings WriteIni File, "Test3", "Ini1", "This is ini 1" WriteIni File, "Test1", "Ini2", "This is ini 2" 'inform we're written the data MsgBox Format((FileLen(File) - OFLen) / 1024, "0.00") & " KB data written to " & Chr(34) & File & Chr(34) 'read the ini file Str = Str & "Test2 section: " & vbTab & ReadIniSection(File, "Test2") & vbCrLf Str = Str & "Test1 section: " & vbTab & ReadIniSection(File, "Test1") & vbCrLf Str = Str & "Ini1 string: " & vbTab & ReadIni(File, "Test3", "Ini1") & vbCrLf Str = Str & "Ini2 string: " & vbTab & ReadIni(File, "Test1", "Ini2") & vbCrLf 'show data MsgBox Str 'end application End End Sub '// INI CONTROLLING PROCEDURES 'reads ini string Public Function ReadIni(Filename As String, Section As String, Key As String) As String Dim RetVal As String * 255, v As Long v = GetPrivateProfileString(Section, Key, "", RetVal, 255, Filename) ReadIni = Left(RetVal, v - 1) End Function 'reads ini section Public Function ReadIniSection(Filename As String, Section As String) As String Dim RetVal As String * 255, v As Long v = GetPrivateProfileSection(Section, RetVal, 255, Filename) ReadIniSection = Left(RetVal, v - 1) End Function 'writes ini Public Sub WriteIni(Filename As String, Section As String, Key As String, Value As String) WritePrivateProfileString Section, Key, Value, Filename End Sub 'writes ini section Public Sub WriteIniSection(Filename As String, Section As String, Value As String) WritePrivateProfileSection Section, Value, Filename End Sub
2. How to send e-mail?
Have a look at this official FAQ article: How do I send an email using Outlook
3.How to work with registry?
VB Code:
'Savesetting Private Sub Form_Unload(Cancel As Integer) SaveSetting "RegCust", "Startup", "Backup", strDate SaveSetting "RegCust", "Startup", "LastEntry",intLastEntry End Sub 'GetSetting Private Sub Form_Load() Dim intLastEntry As Integer intLastEntry = GetSetting("RegCust", "Startup", _ "LastEntry", "0") End Sub 'DeleteSetting Private Sub cmdDelKey_Click() DeleteSetting "RegCust", "StartUp", "LastEntry" End Sub Private Sub cmdDelSection_Click() DeleteSetting "RegCust", "StartUp" End Sub Private Sub cmdUnInstall_Click() DeleteSetting "RegCust" End Sub
4. How to open Password protected Access db?
VB Code:
'connection to secure database Dim Cnn As ADODB.Connection 'In the place where you want to establish your connection, such 'as the Initialize event of a class module, enter the following: Dim strConnect As String Set Cnn = New ADODB.Connection 'Substitute your own User IDs, Password, Data Source, and System 'database in the connection string below strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Password=MyPassword;User ID=Administrator;" & _ "Data Source=C:\AccessDBs\DB1.mdb;" & _ "Persist Security Info=True;" & _ "Jet OLEDB:System database=C:\AccessDBs\system.mdw" 'if you don't need you can eliminate the last line in connection string With Cnn .CursorLocation = adUseClient .Open strConnect End With
5. How to save image in db?
Have a look at this official FAQ article: Database - How can I store images (or other files) in a database?
6. How to write/read text file?
VB Code:
'write Option Explicit 'Set a reference to Microsoft Scripting Runtime Private Sub Command1_Click() Dim fs As FileSystemObject Dim ts As TextStream Set fs = New FileSystemObject 'To write Set ts = fs.OpenTextFile("C:\mytestfile.txt", ForWriting, True) ts.WriteLine "I Love" ts.WriteLine "VB Forums" ts.Close 'To Read If fs.FileExists("C:\mytestfile.txt") Then Set ts = fs.OpenTextFile("C:\mytestfile.txt") Do While Not ts.AtEndOfStream MsgBox ts.ReadLine Loop ts.Close End If Set ts = Nothing Set fs = Nothing End Sub 'read Function FileText(ByVal filename As String) As String Dim handle As Integer ' ensure that the file exists If Len(Dir$(filename)) = 0 Then Err.Raise 53 ' File not found End If ' open in binary mode handle = FreeFile Open filename$ For Binary As #handle ' read the string and close the file FileText = Space$(LOF(handle)) Get #handle, , FileText Close #handle End Function
7. How to fix invalid characters in sql criteria?
VB Code:
Crit="Mark's" strSQL = "SELECT * FROM MyTable WHERE ComField ='" & CleanText(Crit) & "'" Public Function CleanText(strIn As String) As String On Error GoTo VBError Dim iAcnt As Long Dim strString As String Dim vLimit As Long vLimit = Len(strIn) For iAcnt = 1 To vLimit Select Case Asc(Mid$(strIn, iAcnt, 1)) Case 10, 13 strString = strString & Mid$(strIn, iAcnt, 1) Case 124 strString = strString & "!" Case 39 strString = strString & "''" Case 34 strString = strString & """" Case Is < 32 strString = strString & " " Case Is > 126 strString = strString & " " Case Else strString = strString & Mid$(strIn, iAcnt, 1) End Select Next CleanText = strString CleanText = Trim$(CleanText) Exit Function VBError: MsgBox "VBError in Sub Parse_SQL_Text : " & Err.Number & " - " & Err.Description Resume Next End Function
8. How to dynamically add controls?
VB Code:
Dim WithEvents vTextBox As TextBox Set vTextBox = Controls.Add("vb.textbox", "DeeU")
Last edited by dee-u; Dec 21st, 2008 at 12:15 AM.
-
May 31st, 2005, 12:34 AM
#2
Re: Frequently Asked Questions
9. How to terminate a process?
VB Code:
Option Explicit 'on win2k you need the following: Private Const PROCESS_TERMINATE = &H1 'On nt 9X the following could be enough: Private Const PROCESS_ALL_ACCESS = &H1F0FFF 'in any case, let us use both... Private Const MAX_PATH As Integer = 260 Private Type PROCESSENTRY32 dwSize As Long cntUsage As Long th32ProcessID As Long th32DefaultHeapID As Long th32moduleID As Long cntThreads As Long th32ParentProcessID As Long pcPriClassBase As Long dwFlags As Long szExeFile As String * MAX_PATH End Type Private Declare Function CreateToolHelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long Private Declare Function TerminateProcess Lib "kernel32" (ByVal ApphProcess As Long, ByVal uExitCode As Long) As Long Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Public Function KillApp(myName As String) As Boolean Dim uProcess As PROCESSENTRY32 Dim rProcessFound As Long Dim hSnapShot As Long Dim szExename As String Dim exitCode As Long Dim myProcess As Long Dim iFound As Integer On Error GoTo ErrHandler Const TH32CS_SNAPPROCESS As Long = 2& uProcess.dwSize = Len(uProcess) hSnapShot = CreateToolHelpSnapshot(TH32CS_SNAPPROCESS, 0&) rProcessFound = ProcessFirst(hSnapShot, uProcess) Do While rProcessFound iFound = InStr(1, uProcess.szExeFile, Chr(0)) - 1 If iFound > 0 Then szExename = LCase$(Left$(uProcess.szExeFile, iFound)) If Right$(szExename, Len(myName)) = LCase$(myName) Then myProcess = OpenProcess(PROCESS_ALL_ACCESS Or PROCESS_TERMINATE, False, uProcess.th32ProcessID) KillApp = TerminateProcess(myProcess, exitCode) Call CloseHandle(myProcess) 'if you have only one, exit here: 'Exit Function 'if you think you may have more than one, 'let this go on End If rProcessFound = ProcessNext(hSnapShot, uProcess) End If Loop Call CloseHandle(hSnapShot) Exit Function ErrHandler: MsgBox Err.Description End Function
10. How to allow only one instance of app?
VB Code:
'Sol. 1 'in sub main or from_load... If App.PrevInstance = True Then MsgBox "Already running...." End End If 'Sol. 2 Option Explicit Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Public Sub Main() Dim m_hWnd As Long 'Change Form1 to your form Caption. m_hWnd = FindWindow(vbNullString, "Form1") If m_hWnd > 0 Then MsgBox "Program " & App.Title & " is already running..." Unload Form1 Exit Sub End If 'Change Form1 to your form name. Form1.Show End Sub
11. How to correctly end app?
VB Code:
Dim frm as Form For Each frm in Forms if frm.hWnd<> Me.hWnd then Unload frm End If Next
12. How to delete a file?
VB Code:
'Sol. 1 Kill C:\Your_Folder\Yourfile.EXE 'Sol. 2 Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") fso.Deletefile ("c:\windows\desktop\doc1.doc") 'Sol. 3 (Move to recycle bin) Private Type SHFILEOPSTRUCT hWnd As Long wFunc As Long pFrom As String pToAs String fFlagsAs Integer fAborted As Boolean hNameMaps As Long sProgress As String End Type Private Const FO_DELETE = &H3 Private Const FOF_ALLOWUNDO = &H40 Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long ' Delete a single file lResult = ShellDelete("DELETE.ME") ' Delete several files lResult = ShellDelete("DELETE.ME", "LOVE_LTR.DOC", "COVERUP.TXT") Public Function ShellDelete(ParamArray vntFileName() As Variant) As Long Dim I As Integer Dim sFileNames As String Dim SHFileOp As SHFILEOPSTRUCT For I = LBound(vntFileName) To UBound(vntFileName) sFileNames = sFileNames & vntFileName(I) & vbNullChar Next sFileNames = sFileNames & vbNullChar With SHFileOp .wFunc = FO_DELETE .pFrom = sFileNames .fFlags = FOF_ALLOWUNDO End With ShellDelete = SHFileOperation(SHFileOp) End Function
13. How to make a form always on top?
VB Code:
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long Private Const SWP_NOMOVE = &H2 Private Const SWP_NOSIZE = &H1 Private Const HWND_TOPMOST = -1 SetWindowPos FormName.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
14. Block keyboard and mouse (win98)
VB Code:
'Sol. 1 Private Declare Function BlockInput Lib "user32" (ByVal fBlock As Long) As Long Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Private Sub Form_Activate() DoEvents 'block the mouse and keyboard input BlockInput True 'wait 10 seconds before unblocking it Sleep 10000 'unblock the mouse and keyboard input BlockInput False End Sub 'Sol. 2 private sub command1_click() dim aa aa=shell("rundll keyboard,disable") 'this line will disable the Keyboard End Sub private sub command2_click() dim aa aa=shell("RUNDLL MOUSE,DISABLE") 'this line will disable the Mouse End Sub
15. How to disable the Close (X) button on form?
VB Code:
Option Explicit Public Declare Function GetSystemMenu Lib "user32" _ (ByVal hwnd As Long, _ ByVal bRevert As Long) As Long Public Declare Function RemoveMenu Lib "user32" _ (ByVal hMenu As Long, _ ByVal nPosition As Long, _ ByVal wFlags As Long) As Long Public Const MF_BYPOSITION = &H400& Public Sub DisableCloseWindowButton(frm As Form) Dim hSysMenu As Long 'Get the handle to this windows 'system menu hSysMenu = GetSystemMenu(frm.hwnd, 0) 'Remove the Close menu item 'This will also disable the close button RemoveMenu hSysMenu, 6, MF_BYPOSITION 'Lastly, we remove the seperator bar RemoveMenu hSysMenu, 5, MF_BYPOSITION End Sub '--end code block Now call the DisableCloseWindowButton from your forms load event. Private Sub Form_Load() DisableCloseWindowButton Me End Sub
16. How to get IP?
http://www.vbforums.com/showthread.php?t=338329
17. How to Shell and wait?
VB Code:
Option Explicit Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long Const INFINITE = -1& Private Function shellAndWait(ByVal fileName As String) As Long Dim executionStatus As Long Dim processHandle As Long Dim returnValue As Long 'Execute the application/file executionStatus = Shell(fileName, vbNormalFocus) 'Get the Process Handle processHandle = OpenProcess(&H100000, True, executionStatus) 'Wait till the application is finished returnValue = WaitForSingleObject(processHandle, INFINITE) 'Send the Return Value Back shellAndWait = returnValue End Function Private Sub Command1_Click() 'launch the application and wait Dim fileName As String Dim retrunValue As Long fileName = "EXCEL.EXE" retrunValue = shellAndWait(fileName) If retrunValue = 0 Then MsgBox "Application executed and was finished" End If End Sub
18. How to deal with SysTray?
http://www.vbforums.com/showthread.p...hlight=systray
19. How to autocomplete combobox?
VB Code:
Option Explicit public Const CB_FINDSTRING = &H14C Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Function AutoComplete(cbCombo As ComboBox, sKeyAscii As Integer, Optional bUpperCase As Boolean = True) As Integer Dim lngFind As Long, intPos As Integer, intLength As Integer Dim tStr As String With cbCombo If sKeyAscii = 8 Then If .SelStart = 0 Then Exit Function .SelStart = .SelStart - 1 .SelLength = 32000 .SelText = "" Else intPos = .SelStart tStr = .Text If bUpperCase = True Then .SelText = UCase(Chr(sKeyAscii)) Else .SelText = UCase(Chr(sKeyAscii)) End If End If lngFind = SendMessage(.hwnd, CB_FINDSTRING, 0, ByVal .Text) If lngFind = -1 Then .Text = tStr .SelStart = intPos .SelLength = (Len(.Text) - intPos) AutoComplete = 0 Exit Function Else intPos = .SelStart intLength = Len(.List(lngFind)) - Len(.Text) .SelText = .SelText & Right(.List(lngFind), intLength) .SelStart = intPos .SelLength = intLength End If End With End Function
Last edited by dee-u; May 31st, 2005 at 11:00 PM.
-
May 31st, 2005, 04:52 AM
#3
Re: Frequently Asked Questions
20. How can I copy the contents of one listbox to another?
VB Code:
Dim I As Integer For I = 0 To lstName1.Count lstName2.AddItem lstName1.List(I) Next I
21. I get an error number 7 message when trying to run my program, why?
This is an error that states that you have run out of memory. See here for information on the possible causes and solutions.
22. How do I open a webpage in the defult browser?
Simple, use the ShellExecute API Call as shows below 
VB Code:
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _ ByVal hWnd As Long, _ ByVal lpOperation As String, _ ByVal lpFile As String, _ ByVal lpParameters As String, _ ByVal lpDirectory As String, _ ByVal nShowCmd As Long) As Long Private Sub OpenURL(strURL As String) ShellExecute Me.hWnd, "open", strURL, vbNullString, "C:\", ByVal 1& ' Change the last perameter to 0& if you do not whant to show the window. End Sub
Just call the OpenURL sub with the URL of the webpage to open as its perameter. 
23. How do I open a file type with its default application?
Again, use the ShellExecute AI function.
VB Code:
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _ ByVal hWnd As Long, _ ByVal lpOperation As String, _ ByVal lpFile As String, _ ByVal lpParameters As String, _ ByVal lpDirectory As String, _ ByVal nShowCmd As Long) As Long Private Sub OpenAFile(strFileLocation As String) If Dir$(strFileLocation) = "" Then Exit Sub End If ShellExecute Me.hWnd, "open", strURL, vbNullString, "C:\", ByVal 1& ' Change the last perameter to 0& if you do not whant to show the window. End Sub
Just call the OpenAFile sub with the path of the file to open as its perameter. 
24. How can I check if a file exists?
VB Code:
Private Function CheckPath(strPath As String) As Boolean If Dir$(strPath) <> "" Then CheckPath = True Else CheckPath = False End If End Function
Just call the above function with the path of the file to check as its perameter 
25. How do I create a "browse for folder" dialog box?
Use this Module kindly provided by manavo11.
26. How do I make my application start up with Windows?
Have a look at this thread, a good example was posted there.
26. How do I shutdown / restart / logoff a computer?
Again an API call holds the answer:
VB Code:
Private Const EWX_LOGOFF = 0 Private Const EWX_SHUTDOWN = 1 Private Const EWX_REBOOT = 2 Private Const EWX_FORCE = 4 Private Declare Function ExitWindowsEx Lib "user32.dll" ( _ ByVal uFlags As Long, _ ByVal dwReserved As Long) As Long
To Shutdown Windows call this:
VB Code:
Call ExitWindowsEx(EWX_SHUTDOWN, 0)
To Restart Windows call this:
VB Code:
Call ExitWindowsEx(EWX_REBOOT, 0)
To logoff Windows call this:
VB Code:
Call ExitWindowsEx(EWX_LOGOFF, 0)
27. How do I create a form that is not square shaped?
Have a lok at this thread. Some useful links were posted there.
Cheers,
RyanJ
Last edited by sciguyryan; May 31st, 2005 at 01:13 PM.
-
May 31st, 2005, 05:29 AM
#4
Re: Frequently Asked Questions
28. What does the $ notation after a variable name mean?
Those were the old-BASIC style for declaring variables that are not often used anymore. The full list is included below.
String: $
Integer: %
Long: &
Single: !
Double: #
Currency: @
29. How do i get the hard disk ID number?
VB Code:
Private Function DriveSerial(strDrive As String) As String ' Returns the drive serial number. Dim FSO As Object Set FSO = CreateObject("Scripting.FileSystemObject") If Len(strDrive) > 3 Then Exit Sub End If If (FSO.GetDrive(strDrive).IsReady = True) And (Not GetDriveType(strDrive) = 5) Then DriveSerial = CStr(FSO.GetDrive(strDrive).SerialNumber) Else DriveSerial = "Not Available" End If End Property
30. How can I get a list of all the fonts installed on the system?
VB has a built in array of these as part of the Screen object, it is called:
31. Howcan I tell if Internet Explorer is running?
Use the following function.
VB Code:
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _ ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long Private Function IsIERunning() As Boolean Dim lngRet As Long lngRet = FindWindow("IEFrame", vbNullString) If lngRet <> 0 Then IsIERunning = True Else IsIERunning = False End If End Function
Just call the IsIERunning function, it will return a boolean value representing if it is, or if not running 
Cheers,
RyanJ
Last edited by sciguyryan; Jun 5th, 2005 at 09:11 AM.
-
May 31st, 2005, 06:22 AM
#5
Re: Frequently Asked Questions
32. How to pause computer?
VB Code:
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Private Sub PauseComputer(byval vMSec as long) Sleep vMSec End Sub
33. How to seek in a file?
VB Code:
private Function GetLastLine(byval FileName as string) as string Dim iFile as Integer Dim lFileLen as Long Dim sBuffer as string Dim iPos as Integer ' ' You might need to play with the offset depending on how big ' your 'lines' usually are in the file ' Const OFFSET as Long = 160 ' ' The line delimiter string - in this case I'm using VBCRLF, it ' could just be LF in some cases, again, be careful ' Const FINDSTR as string = vbCrLf ' iFile = FreeFile sBuffer = Space$(OFFSET) ' Open FileName for binary Access Read as #iFile seek #iFile, (LOF(iFile) - OFFSET) get #iFile, , sBuffer Close #iFile ' iPos = InStrRev(sBuffer, FINDSTR) If iPos = 0 then GetLastLine = sBuffer else GetLastLine = mid$(sBuffer, iPos + len(FINDSTR)) End If ' End Function
34. How to get computer name?
VB Code:
Private Const MAX_COMPUTERNAME_LENGTH As Long = 31 Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long Private Sub Form_Load() Dim dwLen As Long Dim strString As String 'Create a buffer dwLen = MAX_COMPUTERNAME_LENGTH + 1 strString = String(dwLen, "X") 'Get the computer name GetComputerName strString, dwLen 'get only the actual data strString = Left(strString, dwLen) 'Show the computer name MsgBox strString End Sub
35. How to create shortcut?
VB Code:
'Sol. 1 'add a reference to Windows Script Host Model Dim WshShell As New WshShell Dim oShellLink As WshShortcut 'Create and save the shortcut 'Here, it is important the the extension end by .lnk Set oShellLink = WshShell.CreateShortcut( "C:\TestLink.lnk" ) With oShellLink 'Shortcut to which file (can be anything, .exe, .doc, ...) .TargetPath = "C:\WINNT\SYSTEM32\calc.exe" .WindowStyle = 1 .IconLocation = "C:\WINNT\SYSTEM32\calc.exe, 0" .Arguments = "" .Save End With Set WshShell = Nothing Set oShellLink = Nothing 'Sol. 2 Sub CreateShortCut(File As String, icon As String, iconindex As Long, Target As String) Dim intFreeFile As Integer File = File & ".url" intFreeFile = FreeFile Open File For Output As intFreeFile Print #intFreeFile, "[InternetShortcut]" Print #intFreeFile, "URL=" & Target Print #intFreeFile, "IconFile=" & icon Print #intFreeFile, "Iconindex=" & iconindex Close intFreeFile End Sub CreateShortCut "File","icon","0","c:"
36. How to close an application?
VB Code:
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Const WM_CLOSE = &H10 Private Sub Form_Load() Dim winHwnd As Long Dim RetVal As Long winHwnd = FindWindow(vbNullString, "Calculator") If winHwnd <> 0 Then PostMessage winHwnd, WM_CLOSE, 0&, 0& Else MsgBox "The Calculator is not open." End If End Sub
37. How to make a from transparent?
VB Code:
Public Const GWL_EXSTYLE = (-20) Public Const WS_EX_TRANSPARENT = &H20& Public Const SWP_FRAMECHANGED = &H20 Public Const SWP_NOMOVE = &H2 Public Const SWP_NOSIZE = &H1 Public Const SWP_SHOWME = SWP_FRAMECHANGED Or _ SWP_NOMOVE Or SWP_NOSIZE Public Const HWND_NOTOPMOST = -2 Declare Function SetWindowLong Lib "user32" _ Alias "SetWindowLongA" _ (ByVal hwnd As Long, ByVal nIndex As Long, _ ByVal dwNewLong As Long) As Long Declare Function SetWindowPos Lib "user32" _ (ByVal hwnd As Long, ByVal hWndInsertAfter _ As Long, ByVal x As Long, ByVal y As Long, _ ByVal cx As Long, ByVal cy As Long, _ ByVal wFlags As Long) As Long 'Add a commandbutton with following code to Form1 Private Sub Command1_Click() SetWindowLong Me.hwnd, GWL_EXSTYLE, _ WS_EX_TRANSPARENT SetWindowPos Me.hwnd, HWND_NOTOPMOST, _ 0&, 0&, 0&, 0&, SWP_SHOWME End Sub ' The ShowInTaskbar property should be set to False and the BorderStyle to 0-None.
38. How to create a hotkey?
VB Code:
'Module Code Declare Function SendMessage Lib "user32" Alias _ "SendMessageA" (ByVal hwnd As Long, _ ByVal wMsg As Long, ByVal wParam As Long, _ lParam As Long) As Long Declare Function DefWindowProc Lib "user32" _ Alias "DefWindowProcA" (ByVal hwnd As Long, _ ByVal wMsg As Long, ByVal wParam As Long, _ ByVal lParam As Long) As Long Public Const WM_SETHOTKEY = &H32 Public Const WM_SHOWWINDOW = &H18 Public Const HK_SHIFTA = &H141 'Shift + A Public Const HK_SHIFTB = &H142 'Shift * B Public Const HK_CONTROLA = &H241 'Control + A Public Const HK_ALTZ = &H45A 'The value of the key-combination has to 'declared in lowbyte/highbyte-format 'That means as a hex-number: the last two 'characters specify the lowbyte (e.g.: 41 = a), 'the first the highbyte (e.g.: 01 = 1 = Shift) 'Form Code Private Sub Form_Load() Me.WindowState = vbMinimized 'Let windows know what hotkey you want for 'your app, setting of lParam has no effect erg& = SendMessage(Me.hwnd, WM_SETHOTKEY, _ HK_ALTZ, 0) 'Check if succesfull If erg& <> 1 Then MsgBox "You need another hotkey", vbOKOnly, _ "Error" End If 'Tell windows what it should do, when the hotkey 'is pressed -> show the window! 'The setting of wParam and lParam has no effect erg& = DefWindowProc(Me.hwnd, WM_SHOWWINDOW, _ 0, 0) End Sub 'When the user presses ALT+Z Form1 is shown.
Last edited by dee-u; May 31st, 2005 at 11:05 PM.
-
May 31st, 2005, 12:29 PM
#6
Re: Frequently Asked Questions
39. How do I get the current logged in username?
VB Code:
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" ( _ ByVal lpBuffer As String, _ nSize As Long) As Long Private Function UserName() As String Dim strBuffer As String Dim lngSize As Long strBuffer = Space$(255) lngSize = Len(strBuffer) Call GetUserName(strBuffer, lngSize) UserName = Left$(strBuffer, lngSize) End Function
Simple call the UserName() function :)
40. How can I make it so a compoents can be dragged around the screen?
Use the following code, changing Object to the components name.
VB Code:
' These are global variables! Put them at the top of your form. Dim intX As Integer Dim intY As Integer Private Sub Object_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = vbLeftButton Then intX = X intY = Y Object.MousePointer = vbSizeAll End If End Sub Private Sub Object_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = vbLeftButton Then Object.Left = (Object.Left - intX) + X Object.Top = (Object.Top - intY) + Y End If End Sub Private Sub Object_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Object.MousePointer = vbDefault End Sub
41. How can I add music to my exe?
Use the mciSendString API function. This can play MIDI, MP3, and WAV files. :)
42. How do I create a random number between xxx and xxx?
Use the following function.
VB Code:
Private Function MakeRandom(intLowest As Integer, intHighest As integer) As Long Ramdomize Dim intTemp As Integer If intLowest > intHighest Then intTemp = intLowest intLowest = intHighest intHighest = intTemp End If MakeRandom = CLng((intHighest - intLowest + 1) * Rnd + intLowest) End Function
43. How do I add multiple patterns to the Pattern property of a FileListBox?
Quite simple, just seperate all the file types with a semi-colon (;).
E.G. If you wanted to show all DLL and all OCX files then you would do the following:
VB Code:
filFileListboxName.Pattern = "*.dll;*.ocx"
44. How do I zip / un-zip files using VB?
Have a look here - that is a good example of how it can be done.
Cheers,
RyanJ
Last edited by sciguyryan; Jul 7th, 2010 at 02:09 AM.
-
May 31st, 2005, 04:29 PM
#7
Re: Frequently Asked Questions
45. How do I scroll to the bottom of a multi-line textbox?
VB Code:
Text1.SelStart = Len(Text1)
46. How do I get the number of lines in a text file?
VB Code:
Function NumLines(FileName As String) As Long Dim ff As Integer Dim strBuff As String Dim str() As String ff = FreeFile Open FileName For Input As #ff strBuff = Input(LOF(ff), ff) Close #ff str() = Split(strBuff, vbCrLf) NumLines = UBound(str) - LBound(str) + 1 End Function
-
May 31st, 2005, 10:51 PM
#8
Re: Frequently Asked Questions
47. How to clear all textboxes in a form?
VB Code:
Public Sub ClearTextBoxes(frmClearMe As Form) Dim txt As Control 'clear the text boxes For Each txt In frmClearMe If TypeOf txt Is TextBox Then txt.Text = "" Next End Sub
48. How to cut,copy and paste in MSFlexGrid?
VB Code:
Private Sub EditCut() 'Cut the selection and put it on the Clipboard EditCopy EditDelete End Sub Private Sub EditCopy() 'Copy the selection and put it on the Clipboard Clipboard.Clear Clipboard.SetText MSFlexGrid1.Clip End Sub Private Sub EditPaste() 'Insert Clipboard contents If Len(Clipboard.GetText) Then MSFlexGrid1.Clip = _ Clipboard.GetText End Sub Private Sub EditDelete() 'Deletes the selection Dim i As Integer Dim j As Integer Dim strClip As String With MSFlexGrid1 For i = 1 To .RowSel For j = 1 To .ColSel strClip = strClip & "" & vbTab Next strClip = strClip & vbCr Next .Clip = strClip End With End Sub Private Sub EditSelectAll() 'Selects the whole Grid With MSFlexGrid1 .Visible = False .row = 1 .col = 1 .RowSel = .Rows - 1 .ColSel = .Cols - 1 .TopRow = 1 .Visible = True End With End Sub
49. How to search a listbox?
VB Code:
Option Explicit Private Declare Function SendMessage Lib "User32" _ Alias "SendMessageA" (ByVal hWnd As Long, ByVal _ wMsg As Integer, ByVal wParam As Integer, lParam _ As Any) As Long Const LB_FINDSTRING = &H18F Private Sub Form_Load() With List1 .Clear .AddItem "CPU" .AddItem "RAM" .AddItem "ROM" .AddItem "Cache" .AddItem "Motherboard" .AddItem "Hard Disk" .AddItem "Floppy Disk" End With End Sub Private Sub Text1_Change() List1.ListIndex = SendMessage(List1.hWnd, LB_FINDSTRING, -1, ByVal Text1.Text) Text1.Text = List1.Text End Sub
50. How to search and highlight string in textbox?
VB Code:
Public Function searchHighlight(srchTextBox As textBox, srchString As String) On Error Resume Next Dim A As Integer Call srchTextBox.SetFocus SendKeys ("^{HOME}") A = 1 Do Until A = Len(srchTextBox.text) 'if word was found... If Mid$(UCase$(srchTextBox.text), A, Len(srchString)) = UCase$(srchString) Then 'highlight the word For A = 1 To Len(srchString) SendKeys ("+{RIGHT}") Next A Exit Do End If 'if word isnt found or a return is found ' , dont do anything If Mid(srchTextBox.text, A, 1) = Chr$(13) Then Else 'go to next line SendKeys ("{RIGHT}") End If A = A + 1 If A > Len(srchTextBox.text) Then Exit Do Loop End Function
51. How to make the title bar flash?
VB Code:
Private Declare Function FlashWindow _ Lib "user32" (ByVal hwnd As Long, _ ByVal bInvert As Long) As Long Private Sub tmrFlash_Timer() Dim lngRet As Long '// Flash the window lngRet = FlashWindow(Me.hwnd, 1) End Sub Private Sub cmdFlash_Click() '// Flash every 0.5 seconds tmrFlash.Interval = 500 tmrFlash.Enabled = True End Sub Private Sub Form_Load() '// Don't start flashing yet tmrFlash.Enabled = False End Sub
52. How to find out how long Windows has been running?
VB Code:
Declare Function GetTickCount& Lib "kernel32" () Private Sub cmdWinRun_Click() MsgBox GetTickCount End Sub
53. How to compact Access database using ado?
VB Code:
Public Sub CompactDB() 'Microsoft Jet and Replication objects Dim objJE As New JRO.JetEngine, strSource As String, strTarget As String DoEvents Busy True strSource = " " strTarget = " " objJE.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strSource & ";", "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strTarget & ";Jet OLEDB:Engine Type=4;" Busy False 'Engine type: 'Access 97 = 4 'Access 2000 = 5 End Sub
54. How to determine if app is running in IDE?
VB Code:
Public Function IsIDE() As Boolean On Error GoTo ErrHandler 'because debug statements are ignored when 'the app is compiled, the next statment will 'never be executed in the EXE. Debug.Print 1 / 0 IsIDE = False Exit Function ErrHandler: 'If we get an error then we are 'running in IDE / Debug mode IsIDE = True End Function
Last edited by dee-u; Jun 1st, 2005 at 02:39 AM.
-
Jun 1st, 2005, 05:35 AM
#9
Re: Frequently Asked Questions
55. How can I use command line perameters in my program
Command line parameters are automatically assigned to a string variable called Command$.
I would suggest the use of something like the following: (Assuming you have used a space to seperate each parameter)
VB Code:
Dim strParameters() As String strParameters = Split(Command$, " ") Select Case strParameters(0) Case "inimake" ' Do soemthing here Case Else ' Do something else here. End Select
Of corse you'll need to add error checking and the such 
56. How can I check is my application is minamized?
Quite simple:
VB Code:
If Me.WindowState = vbMinimized Then ' Your program is minimized End If
57. How can I find the number of the lowest and highest element in an array?
To find the lowest element number you can use the LBound function.
To find the last element number in the array you can use the UBound function.
58. How can I disable the "X" Minamize and Maxamize buttons in a MID form?
Have a look here. That link contains all the information you will need.
59. How can I disable Ctrl + Alt + Delete? How can I send Ctrl + Alt + Delete using the SendKeys function?
There are no shure ways to do these. Some will only work in Windows 98 and then it does not work all the time so to put it simply just take it that you cannot do the above tasks.
Cheers,
RyanJ
Last edited by sciguyryan; Jun 1st, 2005 at 05:58 AM.
-
Jun 1st, 2005, 08:38 AM
#10
Re: Frequently Asked Questions
60. How to get the correct path of a special folder (e.g. My Documents, Program Files)
Code:
Const CSIDL_DESKTOP As Long = &H0
Const CSIDL_INTERNET As Long = &H1
Const CSIDL_PROGRAMS As Long = &H2
Const CSIDL_CONTROLS As Long = &H3
Const CSIDL_PRINTERS As Long = &H4
Const CSIDL_PERSONAL As Long = &H5
Const CSIDL_FAVORITES As Long = &H6
Const CSIDL_STARTUP As Long = &H7
Const CSIDL_RECENT As Long = &H8
Const CSIDL_SENDTO As Long = &H9
Const CSIDL_BITBUCKET As Long = &HA
Const CSIDL_STARTMENU As Long = &HB
Const CSIDL_MYDOCUMENTS As Long = &HC
Const CSIDL_MYMUSIC As Long = &HD
Const CSIDL_MYVIDEO As Long = &HE
Const CSIDL_DESKTOPDIRECTORY As Long = &H10
Const CSIDL_DRIVES As Long = &H11
Const CSIDL_NETWORK As Long = &H12
Const CSIDL_NETHOOD As Long = &H13
Const CSIDL_FONTS As Long = &H14
Const CSIDL_TEMPLATES As Long = &H15
Const CSIDL_COMMON_STARTMENU As Long = &H16
Const CSIDL_COMMON_PROGRAMS As Long = &H17
Const CSIDL_COMMON_STARTUP As Long = &H18
Const CSIDL_COMMON_DESKTOPDIRECTORY As Long = &H19
Const CSIDL_APPDATA As Long = &H1A
Const CSIDL_PRINTHOOD As Long = &H1B
Const CSIDL_LOCAL_APPDATA As Long = &H1C
Const CSIDL_ALTSTARTUP As Long = &H1D
Const CSIDL_COMMON_ALTSTARTUP As Long = &H1E
Const CSIDL_COMMON_FAVORITES As Long = &H1F
Const CSIDL_INTERNET_CACHE As Long = &H20
Const CSIDL_COOKIES As Long = &H21
Const CSIDL_HISTORY As Long = &H22
Const CSIDL_COMMON_APPDATA As Long = &H23
Const CSIDL_WINDOWS As Long = &H24
Const CSIDL_SYSTEM As Long = &H25
Const CSIDL_PROGRAM_FILES As Long = &H26
Const CSIDL_MYPICTURES As Long = &H27
Const CSIDL_PROFILE As Long = &H28
Const CSIDL_PROGRAM_FILES_COMMON As Long = &H2B
Const CSIDL_COMMON_TEMPLATES As Long = &H2D
Const CSIDL_COMMON_DOCUMENTS As Long = &H2E
Const CSIDL_COMMON_ADMINTOOLS As Long = &H2F
Const CSIDL_ADMINTOOLS As Long = &H30
Const CSIDL_CONNECTIONS As Long = &H31
Const CSIDL_COMMON_MUSIC As Long = &H35
Const CSIDL_COMMON_PICTURES As Long = &H36
Const CSIDL_COMMON_VIDEO As Long = &H37
Const CSIDL_RESOURCES As Long = &H38
Const CSIDL_RESOURCES_LOCALIZED As Long = &H39
Const CSIDL_COMMON_OEM_LINKS As Long = &H3A
Const CSIDL_CDBURN_AREA As Long = &H3B
Const CSIDL_COMPUTERSNEARME As Long = &H3D
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, _
ByVal pszPath As String) _
As Long
Public Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
(ByVal hwndOwner As Long, _
ByVal nFolder As Long, _
ByRef pidl As Long) _
As Long
Public Function GetSpecialFolder(ByVal CSIDL As Long) As String
Dim pidl As Long
Dim strPath As String
dim lngPos As Long
Dim csidltopidl As Long
If (csidl) Then
If SHGetSpecialFolderLocation(frmRef.hWnd, csidl, pidl) = 0 Then _
csidltopidl = pidl
Else
csidltopidl = 0&
End If
strPath = Space$(260)
If SHGetPathFromIDList(ByVal pidl, ByVal strPath) Then
lngPos = InStr(strPath, Chr$(0))
If (lngPos) Then _
GetSpecialWinFolder = Left$(strPath, lngPos - 1)
End If
End Function
61. a) Get the hWnd of a combo box's edit portion
Code:
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWndParent As Long, _
ByVal hWndChildAfter As Long, _
ByVal lpszClass As String, _
ByVal lpszTitle As String) _
As Long
Public Function GetComboBoxEdithWnd(ByVal hWnd As Long) As Long
GetComboBoxEdithWnd = FindWindowEx(hWnd, 0, "EDIT", vbNullString)
End Function
in order to...
b) Add Windows' URL and file path auto-completion to a textbox or combo box
Code:
Private Declare Function SHAutoComplete Lib "shlwapi.dll" _
(ByVal hWndEdit As Long, _
ByVal dwFlags As Long) _
As Long
Public Enum SHAutoCompleteFlags
SHACF_DEFAULT = &H0
SHACF_FILESYSTEM = &H1
SHACF_URLHISTORY = &H2
SHACF_URLMRU = &H4
SHACF_USETAB = &H8
SHACF_URLALL = (SHACF_URLHISTORY Or SHACF_URLMRU)
SHACF_FILESYS_ONLY = &H10
SHACF_FILESYS_DIRS = &H20
SHACF_AUTOSUGGEST_FORCE_ON = &H10000000
SHACF_AUTOSUGGEST_FORCE_OFF = &H20000000
SHACF_AUTOAPPEND_FORCE_ON = &H40000000
SHACF_AUTOAPPEND_FORCE_OFF = &H80000000
End Enum
Public Function AutoComplete(ByVal hWnd As Long, _
ByVal penmFlags As SHAutoCompleteFlags) _
As Long
AutoComplete = (SHAutoComplete(hWnd, penmFlags))
End Function
Edit: Left out a couple of API declares, thanks CVMichael
Last edited by penagate; Jun 1st, 2005 at 12:28 PM.
Reason: Window's vs. Windows'
-
Jun 1st, 2005, 12:24 PM
#11
Re: Frequently Asked Questions
Dee-u, I like your code, but I have a problem with point 50.
I would not trust "SendKeys" since it sends the keys on window(control) that curently selected, even if you select it first, you don't know for sure that maybe another app may change the selection right after that...
Also, checking character by character is a slow process.
Anyways, I think this is better:
50. How to search and highlight string in textbox?
VB Code:
Public Sub searchHighlight(srchTextBox As TextBox, srchString As String) Dim Pos As Long Pos = InStr(1, srchTextBox.Text, srchString, vbTextCompare) If Pos > 0 Then srchTextBox.SetFocus srchTextBox.SelStart = Pos - 1 srchTextBox.SelLength = Len(srchString) End If End Sub
-
Jun 1st, 2005, 01:10 PM
#12
Re: Frequently Asked VB Questions
62. How can I do high-resolution timing?
Define these functions
VB Code:
Option Explicit Private Declare Function QueryPerformanceCounter Lib "Kernel32" _ (X As Currency) As Boolean Private Declare Function QueryPerformanceFrequency Lib "Kernel32" _ (X As Currency) As Boolean Private Type TimerData StartCount As Currency StopCount As Currency Overhead As Currency Frequency As Currency End Type 'returns the number of seconds elapsed between StopCount and StartCount 'Assumes that InitPerformanceTimer has been called Private Function ElapsedTime(MyData As TimerData) As Single With MyData ElapsedTime = (.StopCount - .StartCount - .Overhead) / .Frequency 'seconds End With End Function 'Initializes the data structure so that the ElapsedTime function can be called 'Returns false if the High-resolution timer is not supported Private Function InitPerformanceTimer(MyData As TimerData) As Boolean Dim Ctr1 As Currency, Ctr2 As Currency With MyData If QueryPerformanceCounter(Ctr1) Then QueryPerformanceCounter Ctr2 QueryPerformanceFrequency .Frequency '1/Freq*10000 is resolution of timer in seconds Debug.Print "QueryPerformanceCounter minimum resolution: 1/" & _ .Frequency * 10000; " seconds" 'This overhead is present for each call to API .Overhead = Ctr2 - Ctr1 Debug.Print "API Overhead: "; .Overhead / .Frequency; "seconds" InitPerformanceTimer = True Else Debug.Print "High-resolution counter not supported." InitPerformanceTimer = False End If End With End Function
Use it like this
VB Code:
Private Sub Command1_Click() Dim MyData As TimerData Dim i As Integer, b As Integer If Not InitPerformanceTimer(MyData) Then 'sorry, no can do MsgBox "High-resolution counter not supported" Exit Sub Else With MyData b = 0 'get start time QueryPerformanceCounter .StartCount 'perform some task you want to time For i = 1 To 100 b = b + i Next i 'get stop time QueryPerformanceCounter .StopCount 'get elapsed time MsgBox "Elapsed time is " & CStr(ElapsedTime(MyData) * 1000) & " milliseconds." End With End If End Sub
63. How do I get a String from a long pointer?
This question comes up when trying to use certain API functions, and when processing certain Windows messages.
There are two cases to consider.
1. You "own" the string buffer that the pointer points to.
In this case you just need to provide the buffer space and modify the string a little once it's been returned.
Here is an example that gets a window caption.
VB Code:
Option Explicit Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long Private Function GetText(TargethWnd As Long) As String Dim lpString As String Dim maxStr As Long maxStr = 100 lpString = Space(maxStr) If GetWindowText(TargethWnd, lpString, maxStr) = 0 Then MsgBox "GetWindowText failed" GetText = "" Else GetText = Left(lpString, InStr(lpString, Chr(0)) - 1) End If End Function
2. The second case is one where the OS "owns" the buffer and you must copy the string data into a VB String variable.
This example gets string data that is pointed to by a long pointer inside the CopyData Structure.
If you have the declarations
VB Code:
Option Explicit Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Private Type COPYDATASTRUCT dwData As Long cbData As Long lpData As Long End Type Dim MyData As COPYDATASTRUCT Dim X As String
Then you can get the data using this function
VB Code:
'This function returns the string pointed to by pstr 'strCNT is the number of characters in the string 'strings from dlls are terminated with a null character Function StrFromPtr(pStr As Long, Optional strCNT As Long = 256) As String Dim bTemp As Byte Dim i As Long Dim X As String X = "" For i = 0& To strCNT - 1 CopyMemory bTemp, ByVal pStr + i, 1 'convert LF to CR & LF If bTemp = 10 Then X = X & vbCrLf Else X = X & Chr(bTemp) End If Next i StrFromPtr = X End Function
Using it like so:
VB Code:
X = StrFromPtr(MyData.lpData, MyData.cbData)
64. How do I do video Capture from VB?
Check out this excellent port of Vidcap32 to VB
http://www.shrinkwrapvb.com/vbvidcap.htm
Last edited by moeur; Jun 2nd, 2005 at 03:28 PM.
-
Jun 2nd, 2005, 12:19 AM
#13
Software Eng.
Re: Frequently Asked VB Questions
You might want to edit your first post to include a table on contents.
-
Jun 2nd, 2005, 04:29 PM
#14
Re: Frequently Asked VB Questions
63. How do I load a Word / Excel file using VB without using Shell, ShellExecute or, without adding an office reference to my project?
Use the following code:
Word:
VB Code:
Dim wdWord As Object Dim wdDocument As Object Set wdWord = CreateObject("Word.Application") Set wdDocument = CreateObject("Word.Document") Set wdDocument = wdWord.Documents.Open("Path_To_Some_File_Here.doc")
Excel:
VB Code:
Dim exExcel As Object Set exExcel = CreateObject("Excel.Application") exExcel.Workbooks.Open ("Path_To_Some_File_Here.xls") exExcel.Visible = True
Cheers,
RyanJ
Last edited by sciguyryan; Jun 2nd, 2005 at 04:47 PM.
-
Jul 7th, 2008, 09:20 PM
#15
Re: Frequently Asked Questions
 Originally Posted by dee-u
9. How to terminate a process?
VB Code:
Option Explicit 'on win2k you need the following: Private Const PROCESS_TERMINATE = &H1 'On nt 9X the following could be enough: Private Const PROCESS_ALL_ACCESS = &H1F0FFF 'in any case, let us use both... Private Const MAX_PATH As Integer = 260 Private Type PROCESSENTRY32 dwSize As Long cntUsage As Long th32ProcessID As Long th32DefaultHeapID As Long th32moduleID As Long cntThreads As Long th32ParentProcessID As Long pcPriClassBase As Long dwFlags As Long szExeFile As String * MAX_PATH End Type Private Declare Function CreateToolHelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long Private Declare Function TerminateProcess Lib "kernel32" (ByVal ApphProcess As Long, ByVal uExitCode As Long) As Long Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Public Function KillApp(myName As String) As Boolean Dim uProcess As PROCESSENTRY32 Dim rProcessFound As Long Dim hSnapShot As Long Dim szExename As String Dim exitCode As Long Dim myProcess As Long Dim iFound As Integer On Error GoTo ErrHandler Const TH32CS_SNAPPROCESS As Long = 2& uProcess.dwSize = Len(uProcess) hSnapShot = CreateToolHelpSnapshot(TH32CS_SNAPPROCESS, 0&) rProcessFound = ProcessFirst(hSnapShot, uProcess) Do While rProcessFound iFound = InStr(1, uProcess.szExeFile, Chr(0)) - 1 If iFound > 0 Then szExename = LCase$(Left$(uProcess.szExeFile, iFound)) If Right$(szExename, Len(myName)) = LCase$(myName) Then myProcess = OpenProcess(PROCESS_ALL_ACCESS Or PROCESS_TERMINATE, False, uProcess.th32ProcessID) KillApp = TerminateProcess(myProcess, exitCode) Call CloseHandle(myProcess) 'if you have only one, exit here: 'Exit Function 'if you think you may have more than one, 'let this go on End If rProcessFound = ProcessNext(hSnapShot, uProcess) End If Loop Call CloseHandle(hSnapShot) Exit Function ErrHandler: MsgBox Err.Description End Function
10. How to allow only one instance of app?
VB Code:
'Sol. 1 'in sub main or from_load... If App.PrevInstance = True Then MsgBox "Already running...." End End If 'Sol. 2 Option Explicit Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Public Sub Main() Dim m_hWnd As Long 'Change Form1 to your form Caption. m_hWnd = FindWindow(vbNullString, "Form1") If m_hWnd > 0 Then MsgBox "Program " & App.Title & " is already running..." Unload Form1 Exit Sub End If 'Change Form1 to your form name. Form1.Show End Sub
11. How to correctly end app?
VB Code:
Dim frm as Form For Each frm in Forms if frm.hWnd<> Me.hWnd then Unload frm End If Next
12. How to delete a file?
VB Code:
'Sol. 1 Kill C:\Your_Folder\Yourfile.EXE 'Sol. 2 Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") fso.Deletefile ("c:\windows\desktop\doc1.doc") 'Sol. 3 (Move to recycle bin) Private Type SHFILEOPSTRUCT hWnd As Long wFunc As Long pFrom As String pToAs String fFlagsAs Integer fAborted As Boolean hNameMaps As Long sProgress As String End Type Private Const FO_DELETE = &H3 Private Const FOF_ALLOWUNDO = &H40 Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long ' Delete a single file lResult = ShellDelete("DELETE.ME") ' Delete several files lResult = ShellDelete("DELETE.ME", "LOVE_LTR.DOC", "COVERUP.TXT") Public Function ShellDelete(ParamArray vntFileName() As Variant) As Long Dim I As Integer Dim sFileNames As String Dim SHFileOp As SHFILEOPSTRUCT For I = LBound(vntFileName) To UBound(vntFileName) sFileNames = sFileNames & vntFileName(I) & vbNullChar Next sFileNames = sFileNames & vbNullChar With SHFileOp .wFunc = FO_DELETE .pFrom = sFileNames .fFlags = FOF_ALLOWUNDO End With ShellDelete = SHFileOperation(SHFileOp) End Function
13. How to make a form always on top?
VB Code:
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long Private Const SWP_NOMOVE = &H2 Private Const SWP_NOSIZE = &H1 Private Const HWND_TOPMOST = -1 SetWindowPos FormName.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
14. Block keyboard and mouse (win98)
VB Code:
'Sol. 1 Private Declare Function BlockInput Lib "user32" (ByVal fBlock As Long) As Long Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Private Sub Form_Activate() DoEvents 'block the mouse and keyboard input BlockInput True 'wait 10 seconds before unblocking it Sleep 10000 'unblock the mouse and keyboard input BlockInput False End Sub 'Sol. 2 private sub command1_click() dim aa aa=shell("rundll keyboard,disable") 'this line will disable the Keyboard End Sub private sub command2_click() dim aa aa=shell("RUNDLL MOUSE,DISABLE") 'this line will disable the Mouse End Sub
15. How to disable the Close (X) button on form?
VB Code:
Option Explicit Public Declare Function GetSystemMenu Lib "user32" _ (ByVal hwnd As Long, _ ByVal bRevert As Long) As Long Public Declare Function RemoveMenu Lib "user32" _ (ByVal hMenu As Long, _ ByVal nPosition As Long, _ ByVal wFlags As Long) As Long Public Const MF_BYPOSITION = &H400& Public Sub DisableCloseWindowButton(frm As Form) Dim hSysMenu As Long 'Get the handle to this windows 'system menu hSysMenu = GetSystemMenu(frm.hwnd, 0) 'Remove the Close menu item 'This will also disable the close button RemoveMenu hSysMenu, 6, MF_BYPOSITION 'Lastly, we remove the seperator bar RemoveMenu hSysMenu, 5, MF_BYPOSITION End Sub '--end code block Now call the DisableCloseWindowButton from your forms load event. Private Sub Form_Load() DisableCloseWindowButton Me End Sub
16. How to get IP?
http://www.vbforums.com/showthread.php?t=338329
17. How to Shell and wait?
VB Code:
Option Explicit Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long Const INFINITE = -1& Private Function shellAndWait(ByVal fileName As String) As Long Dim executionStatus As Long Dim processHandle As Long Dim returnValue As Long 'Execute the application/file executionStatus = Shell(fileName, vbNormalFocus) 'Get the Process Handle processHandle = OpenProcess(&H100000, True, executionStatus) 'Wait till the application is finished returnValue = WaitForSingleObject(processHandle, INFINITE) 'Send the Return Value Back shellAndWait = returnValue End Function Private Sub Command1_Click() 'launch the application and wait Dim fileName As String Dim retrunValue As Long fileName = "EXCEL.EXE" retrunValue = shellAndWait(fileName) If retrunValue = 0 Then MsgBox "Application executed and was finished" End If End Sub
18. How to deal with SysTray?
http://www.vbforums.com/showthread.p...hlight=systray
[B]19. ...[/Highlight]
In Number 12, you should check for the possibility of the user Canceling the dialog. You do that by looking at If FileOperation.fAnyOperationsAborted which will be True in that case.
-
Aug 10th, 2008, 11:43 AM
#16
New Member
Re: Frequently Asked VB Questions
-
Aug 10th, 2008, 02:49 PM
#17
Re: Frequently Asked VB Questions
Most of this stuff is already in the API FAQ or other FAQs. 
VB/Office Guru™ (AKA: Gangsta Yoda™ ®)
I dont answer coding questions via PM. Please post a thread in the appropriate forum. 
Microsoft MVP 2006-2011
Office Development FAQ (C#, VB.NET, VB 6, VBA)
Senior Jedi Software Engineer MCP (VB 6 & .NET), BSEE, CET
If a post has helped you then Please Rate it! 
• Star Wars Gangsta Rap • Reps & Rating Posts • VS.NET on Vista • Multiple .NET Framework Versions • Office Primary Interop Assemblies • VB/Office Guru™ Word SpellChecker™.NET • VB/Office Guru™ Word SpellChecker™ VB6 • VB.NET Attributes Ex. • Outlook Global Address List • API Viewer utility • .NET API Viewer Utility •
System: Intel i7 6850K, Corsair H100i v2 water cooler, Geforce GTX1060, Samsung M.2 500 GB & SATA 500 GB, 32 GBs DDR4 3300 Quad Channel RAM, 2 Viewsonic 24" LCDs, Windows 10, Office 2010, VS 2010 
-
Nov 2nd, 2008, 01:46 AM
#18
New Member
Re: Frequently Asked VB Questions
are all this codes available in VB 6.0?
cause thats the vb version i am using right now for my thesis.
reply asap pls..
thank you so much!
-
Nov 3rd, 2008, 01:16 AM
#19
Re: Frequently Asked VB Questions
 Originally Posted by pyrojoker03
are all this codes available in VB 6.0?
cause thats the vb version i am using right now for my thesis.
reply asap pls..
thank you so much!
Yes this is all in Visual Basic 6.0 but as Rob says most of the stuffs here are already in the official FAQ section which contains more topics and more elaborate on their explanations.
-
Dec 17th, 2008, 11:34 PM
#20
Member
Re: Frequently Asked VB Questions
thanks a ton for all these codes put together in one location. Is very useful for me.
-
Dec 18th, 2008, 08:52 AM
#21
Re: Frequently Asked VB Questions
As dee-u said most of these, along with many other things, are in our Classic VB FAQs (in the FAQ forum, which is shown near the top of our home page) - all organised in an easier to read format.
This thread was created while the FAQs were in progress, and several of the posts here are duplicated in the FAQs (often with more explanation and/or alternative methods of doing the same thing).
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|