Wednesday, June 27, 2012

Window APIs for VBA

In this blog, I'll give you brief idea about Window APIs and their application in VBA.

API stands for Application Programming Interface.
There are several reasons to use Window APIs instead of built-in VBA functions:

Speed - although there might be only a fraction of a millisecond's difference between a VBA function and using an API call, if you are using it repeatedly, then this difference mounts up. A good example of this is recursively searching for a file through the directories and sub-directories.

Extensibility - you wish to perform something that cannot be achieved using VBA functions.


In general, an API is declared as below:


[Private|Public] Declare [Function|Sub] APIName Lib [DLLName] (Alias APIName) (Arguments) (Return Type)


For example:
Private Declare Function apiGetDC Lib "user32" Alias "GetDC" (ByVal hwnd As Long) As Long


[Private|Public]:
This determines the scope of the function of subprocedure. This is mostly a matter of preference. I prefer to declare my API calls private within a module, and then use a function to call them. This allows me to have a module that is stand-alone and can be copied to another database without reliance on other modules.


[Function|Sub]:
Whether it is a subprocedure or a function. Nearly all APIs are functions, and they nearly all return a value directly.

[DLLName]:
The name of the DLL that the procedure is in. For the standard DLLs, user32.dll, kernel32.dll or gdi32.dll you can omit the file extension, but for all other DLLs you must include the file extension.


(Alias APIName):
If you have declared the API as being different from the name that it is known within the DLL you must specify the correct name here. There are several reasons why you may wish to do this:
  • The name of the API is not a valid VBA function name, such as '_lwrite';
  • You are declaring it twice, for example to accept different argument types to get around the 'As Any' variable type;
  • You wish to have a common naming policy for API calls, such as prefixing them all with 'api'
Note that the API name must be in the correct case - 'findfile' is not equal to 'FINDFILE'



(Arguments):
As with VBA procedures, APIs may accept various arguments. However, this is one area where care needs to be taken to ensure that you pass ByRef or ByValue as needed. You will often also need to predeclare string arguments to be a certain length. You may also find that you pass a Type Structure as an argument, and the values that you want are in that Type Structure.
(Return Value):
The datatype that the API returns. Normally this will be a Long Integer, with 0 often indicating an error.

To find more about API please go through:

http://www.applecore99.com/api/api001.asp



The following table lists the common operating environment library files.


Dynamic Link Library Description
Advapi32.dll Advanced API services library supporting
numerous APIs  including many security and Registry calls
Comdlg32.dll Common dialog API library
Gdi32.dll Graphics Device Interface API library
Kernel32.dll Core Windows 32-bit base API support
Lz32.dll 32-bit compression routines
Mpr.dll Multiple Provider Router library
Netapi32.dll 32-bit Network API library
Shell32.dll 32-bit Shell API library
User32.dll Library for user interface routines
Version.dll Version library
Winmm.dll Windows multimedia library
Winspool.drv     Print spooler interface that contains the print








VBA Code for Closing a Workbook after Specified Timeperiod


Sub workbook_open()
Dim start, finish, totaltime, totaltimeinminutes, timeinminutes
Application.DisplayAlerts = True
timeinminutes = 3
    If timeinminutes > 1 Then
    'calculating total remaining time
    totaltimeinminutes = (timeinminutes * 60) - (1 * 60)
    start = Timer
    'do other activity for 2 min.s
    Do While Timer < start + totaltimeinminutes
       DoEvents
    Loop
    finish = Timer
    totaltime = finish - start
    Application.DisplayAlerts = False
    MsgBox "This file has been open for " & totaltime / 60 & "minutes,You have 1 minute to save before Excel closes"
    End If
    start = Timer
    Do While Timer < start + (1 * 60)
        DoEvents
    Loop
    finish = Timer
    totaltime = finish - start
    Application.DisplayAlerts = False
    MsgBox "Excel will now close"
    Application.Quit
End Sub

Monday, June 25, 2012

Using Worksheet function for VBA code



The  macro sums the salaries for employees in a specific department and a specific location

Sub calcSalaries()
Dim objDept As Range, objLoc As Range, objSal As Range
Dim strDept, strLoc As String, cursum As Currency
Sheets("Employees").Activate
With ActiveCell.CurrentRegion
    Set objDept = .Columns(4)
    Set objLoc = .Columns(5)
    Set objSal = .Columns(6)
    strDept = InputBox(Prompt:="Which department(cancel or blank for all departments)?", Default:="Finance")
    If strDept = vbNullString Then strDept = "*"
    strLoc = InputBox(Prompt:="Which department(cancel or blank for all departments)?", Default:="New Delhi")
    If strLoc = vbNullString Then strLoc = "*"
    cursum = WorksheetFunction.SumIfs(objSal, objDept, strDept, objLoc, strLoc)
    MsgBox cursum
    MsgBox "The total for" & strDept & " in" & strLoc & " is:" & FormatCurrency(cursum)
End With


End Sub

Saturday, June 2, 2012

Convert a number to a date using VBA

This VBA procedure converts a number, in yyyymmdd format, to a regular date like mm/dd/yyyy.  For example, a number like 20090427 will get converted to 4/27/2009.





Public Function formatdatefromnumber(dateNumber)
On Error GoTo err_formatdatefromnumber

    Dim fmtYear, fmtMonth, fmtDay As String
        If IsNull(dateNumber) Then
            formatdatefromnumber = vbNullString
            Exit Function
            
        End If
        
        If Len(CStr(dateNumber)) <> 8 Then
            formatdatefromnumber = vbNullString
            Exit Function
        End If
        If Not IsNumeric(dateNumber) Then
            formatdatefromnumber = vbNullString
            Exit Function
        End If
        fmtYear = Mid(dateNumber, 1, 4)
        fmtMonth = Mid(dateNumber, 5, 2)
        
        If CInt(fmtMonth) > 12 Then
        formatdatefromnumber = vbNullString
        Exit Function
        End If
        fmtDay = Mid(dateNumber, 7, 2)
        If CInt(fmtDay) > 31 Then
        formatdatefromnumber = vbNullString
        Exit Function
        End If
        formatdatefromnumber = Format(DateSerial(fmtYear, fmtMonth, fmtDay), "mm/dd/yyyy")
        Exit Function

err_formatdatefromnumber:
MsgBox Err.Number & " " & Err.Description, vbCritical, "DateFromNumber()"
err_formatdatefromnumber = vbNullString
Exit Function
        
End Function

Disable Keyboard in VBA Code


Sub KeyboardOff()

   Application.DataEntryMode = True
End Sub

Friday, June 1, 2012

Disable Right Click When A Sheet Is Active

VBA Code for disable right click when a sheet is active:


Application.CommandBars("Cell").Enabled = False

Using Switch Function in VBA


Sub Exercise()
    Dim Status As Integer, EmploymentStatus As String
    Status = 1
    EmploymentStatus = "Unknown"
    'In the first argument, pass a Boolean expression
    'that can be evaluated to True or False. If that condition
    'is true, the second argument would be executed.
    EmploymentStatus = Switch(Status = 1, "Part Time")
    MsgBox ("Employment Status: " & EmploymentStatus)
End Sub