Friday, March 30, 2012

Register DLL and Reg file with Excel VBA

Here is a function to register DLL or OCX components

 
Public Sub RegisterComponent(sFilename As String, Optional bUnRegister As Boolean = False, Optional bHideResults As Boolean = True)
    If Len(Dir$(sFilename)) = 0 Then
        'File is missing
        MsgBox "Unable to locate file "" & sFileName & """, vbCritical
    Else
        If bUnRegister Then
            'Unregister a component
            If bHideResults Then
                'Hide results
                Shell "regsvr32 /s /u " & """" & sFilename & """"
            Else
                'Show results
                Shell "regsvr32 /u " & """" & sFilename & """"
            End If
        Else
            'Register a component
            If bHideResults Then
                'Hide results
                Shell "regsvr32 /s " & """" & sFilename & """"
            Else
                'Show results
                Shell "regsvr32 " & """" & sFilename & """"
            End If
        End If
    End If
End Sub


For example :
 
Sub test()
    RegisterComponent ("c:\test.dll")
End Sub



Here is a function to export a section of registry to .reg file

Public Sub RegeditExport(sKey As String, sFilename As String)
    Shell "regedit.exe /s /e " & Chr(34) & sFilename & Chr(34) & " " & Chr(34) & sKey & Chr(34), vbHide
End Sub


Here is a function to import windows registry file (.reg file) to the registry
 
Public Sub RegeditImport(sFilename As String)
    Shell "regedit.exe /s /c " & Chr(34) & sFilename & Chr(34), vbHide
End Sub


For example:
 
Sub test()
    RegeditImport "C:\test.reg"
End Sub

Tuesday, March 27, 2012

Get or set computer name function

Here is a function to get or set the computer name


 
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpbuffer As String, nsize As Long) As Long
Private Declare Function SetComputerName Lib "kernel32" Alias "SetComputerNameA" (ByVal lpComputerName As String) As Long

'Purpose     :  Returns the name of the local machine/computer
'Inputs      :  N/A
'Outputs     :  Returns the name of the local machine
'Notes       :  Uses a private static for speed


Public Function MachineName() As String
    Dim lRet As Long
    Dim lMaxLen As Long
    Static ssMachineName As String
    
    If Len(ssMachineName) = 0 Then
        lMaxLen = 100
        ssMachineName = String$(lMaxLen, vbNullChar)
        lRet = GetComputerName(ssMachineName, lMaxLen)
        ssMachineName = Left$(ssMachineName, lMaxLen)
    End If
    MachineName = ssMachineName
End Function

'Purpose     :  Sets the name of the local machine/computer
'Inputs      :  sName           The new name of the local machine/computer
'Outputs     :  Returns True if failed to change local machine name


Function MachineNameSet(sName As String) As Boolean
    MachineNameSet = IIf(SetComputerName(sName & vbNullChar) = 0, False, True)
End Function




Credit : http://www.visualbasic.happycodings.com/Applications-VBA/code23.html

Sunday, March 25, 2012

Read ini value

Function for read a value of each key from ini file.

 
Public Function ReadIniValue(ByVal INIpath As String, ByVal KEY As String, ByVal Variable As String) As String  
 Dim NF As Integer  
 Dim temp As String  
 Dim LcaseTemp As String  
 Dim ReadyToRead As Boolean  
 AssignVariables:  
     NF = FreeFile  
     ReadIniValue = ""  
     KEY = "[" & LCase$(KEY) & "]"  
     Variable = LCase$(Variable)  
 EnsureFileExists:  
   If Dir(INIpath) = "" Then  
    MsgBox " No file you are tring to read ", vbOKOnly, "Error"  
    Exit Function  
   End If  
   'Open INIpath For Binary As NF  
   ' Close NF  
   'SetAttr INIpath, vbArchive  
 LoadFile:  
   Open INIpath For Input As NF  
   While Not EOF(NF)  
      Line Input #NF, temp  
      LcaseTemp = LCase$(Trim(temp))  
      If InStr(LcaseTemp, "[") <> 0 Then ReadyToRead = False  
      If LcaseTemp = KEY Then ReadyToRead = True  
      If InStr(LcaseTemp, "[") = 0 And ReadyToRead = True Then  
       If InStr(LcaseTemp, Variable & "=") = 1 Then  
         ReadIniValue = Mid$(temp, 1 + Len(Variable & "="))  
         Close NF: Exit Function  
         End If  
      End If  
   Wend  
   Close NF  
 End Function  


Wednesday, March 21, 2012

Split function

Split function is used for separating any string to substring by using a specified delimiter.

Syntax
Split(expression[, delimiter[, limit[, compare]]])

For example:
Public Function SplitText(str, n, delim)
'Returns the nth element from a string,
'using a specified separator character

Dim x As Variant    x = Split(str, delim)
    If n > 0 And n - 1 <= UBound(x) Then
       SplitText= x(n - 1)
    Else       SplitText= ""
    End If
End Function


Example: Range("A1") = test1,test2,test3

Sub test()
Dim result1 As String

Dim result2 As String
Dim result3 As String   
   result1 = SplitText(Range("A1").Value, 1, ",") 'result = test1
   result2 = SplitText(Range("A1").Value, 2, ",") 'result = test2
   result3 = SplitText(Range("A1").Value, 3, ",") 'result = test3
End Sub

Wednesday, March 14, 2012

Open another program with Excel VBA

To open another program by using Excel VBA, we can use function "shell" to open it.

Syntax
Shell(pathname[,windowstyle])

pathname
Required; Variant (String). Name of the program to execute and any required arguments or command-line switches; may include directory or folder and drive.

The windowstyle named argument has these values:
Constant
Value
Description
vbHide
0
Window is hidden and focus is passed to the hidden window. The vbHide constant is not applicable on Macintosh platforms.
vbNormalFocus
1
Window has focus and is restored to its original size and position.
vbMinimizedFocus
2
Window is displayed as an icon with focus.
vbMaximizedFocus
3
Window is maximized with focus.
vbNormalNoFocus
4
Window is restored to its most recent size and position. The currently active window remains active.
vbMinimizedNoFocus
6
Window is displayed as an icon. The currently active window remains active.

Here is an example to open Internet Explorer:

-----------------------------------------------------------------------------------------------------------------------
Sub test()
'To search "test" with google
Dim ReturnValue As Double
   ReturnValue = Shell("C:\Program Files\Internet Explorer\iexplore.exe http://www.google.com", 1)
   Application.Wait (Now + TimeValue("0:00:01")) 'wait 1 seconds
   AppActivate ReturnValue
   Application.SendKeys "test" 'search "test" with google
   SendKeys "~", True 'enter

End Sub
-----------------------------------------------------------------------------------------------------------------------

Tuesday, March 6, 2012

SendKeys in VBA

To send text to Excel by using command in Excel marco (VBA), we can use method "SendKeys" to send it. SendKeys is a method to capture key strokes in VBA.

Syntax
expression .SendKeys(Keys, Wait)
expression A variable that represents an Application object.

NameRequired/OptionalData TypeDescription
KeysRequiredVariantThe key or key combination you want to send to the application, as text.
WaitOptionalVariantTrue to have Microsoft Excel wait for the keys to be processed before returning control to the macro. False (or omitted) to continue running the macro without waiting for the keys to be processed.
Key
Code
BACKSPACE
{BACKSPACE} or {BS}
BREAK
{BREAK}
CAPS LOCK
{CAPSLOCK}
CLEAR
{CLEAR}
DELETE or DEL
{DELETE} or {DEL}
DOWN ARROW
{DOWN}
END
{END}
ENTER (numeric keypad)
{ENTER}
ENTER
~ (tilde)
ESC
{ESCAPE} or {ESC}
HELP
{HELP}
HOME
{HOME}
INS
{INSERT}
LEFT ARROW
{LEFT}
NUM LOCK
{NUMLOCK}
PAGE DOWN
{PGDN}
PAGE UP
{PGUP}
RETURN
{RETURN}
RIGHT ARROW
{RIGHT}
SCROLL LOCK
{SCROLLLOCK}
TAB
{TAB}
UP ARROW
{UP}
F1 through F15
{F1} through {F15}

You can also specify keys combined with SHIFT and/or CTRL and/or ALT. To specify a key combined with another key or keys, use the following table.
To combine a key with
Precede the key code with
SHIFT
+ (plus sign)
CTRL
^ (caret)
ALT
% (percent sign)


Here is an example to use SendKeys

-------------------------------------------------------------------------------------------------------------------------
Sub Test()
   Application.SendKeys "{HOME}", True 'send HOME to the Excel and wait for the keys to be processed
   Application.SendKeys "Test" 'send word "Test" to the Excel with default value (without true/false) and not wait for the keys to be processed
End Sub
-------------------------------------------------------------------------------------------------------------------------