Thursday, July 25, 2013

Suffixes after variable name in VBA

Dim A!, B@, C#, D$, E%, F&
Debug.Print "A! - " & TypeName(A)
Debug.Print "B@ - " & TypeName(B)
Debug.Print "C# - " & TypeName(C)
Debug.Print "D$ - " & TypeName(D)
Debug.Print "E% - " & TypeName(E)
Debug.Print "F& - " & TypeName(F)
A! - Single
B@ - Currency
C# - Double
D$ - String
E% - Integer
F& - Long
For Reference:
http://support.microsoft.com/kb/110264

Tuesday, July 16, 2013

Export Userform to Another Workbook

Dim vbcomponent As Variant
Sub exportForm()
On Error Resume Next
Dim wbSource As Workbook, wbDestination As Workbook
Set wbSource = Workbooks.Open("C:\abc\DIR\Desktop\Book1")
Set wbDestination = ThisWorkbook
For Each vbcomponent In wbSource.VBProject.VBComponents
        If (vbcomponent.Name = "displayForm") Then
     
                wbSource.VBProject.VBComponents(vbcomponent.Name).Export "C:\temp\displayForm.frm"
                wbDestination.VBProject.VBComponents.Import "C:\temp\displayForm.frm"
        End If
     
     
Next
        Kill "C:\temp\displayForm.frm"
        Kill "C:\temp\displayForm.frx"
     
wbSource.Close
End Sub

Thursday, July 4, 2013

Sending mails without taking Outlook Reference

If your mailId is configured to Outlook Express; following code will send mails of each excel sheet

Sub Mail_every_Worksheet()

    Dim strDate As String
    Dim sh As Worksheet
    Application.ScreenUpdating = False
    For Each sh In ThisWorkbook.Worksheets
        If sh.Range("a1").Value Like "*@*" Then
            sh.Copy
            strDate = Format(Date, "dd-mm-yy") & " " & Format(Time, "h-mm-ss")
            ActiveWorkbook.SaveAs "Part of " & ThisWorkbook.Name _
                                & " " & strDate & ".xls"
            ActiveWorkbook.SendMail ActiveSheet.Range("a1").Value, _
                                    ActiveSheet.Range("b1").Value
            ActiveWorkbook.ChangeFileAccess xlReadOnly
         
            ActiveWorkbook.Close False
        End If
    Next sh
    Application.ScreenUpdating = True

End Sub

Wednesday, July 3, 2013

Calculate Age Using Nested Select Case

Sub calculateAge()
Dim tempdate As Date, sysdate As Date, mydob As Date
Dim y As Integer, m As Integer, d As Integer
mydob = CDate(Application.InputBox("Select your DoB", "DoB", Default:=Format(Date, "mm/dd/yyyy"), Type:=2))
sysdate = Format(Date, "mm/dd/yyyy")
tempdate = DateSerial(Year(Date), Month(mydob), Day(mydob))

Select Case (tempdate > sysdate)

    Case True
                y = Year(sysdate) - Year(mydob) - 1
             
                Select Case Day(mydob) > Day(Date)
                    Case True
                           
                        m = -Month(mydob) - 12 * (tempdate > sysdate) + Month(Date) - 1
                        d = Day(DateSerial(Year(Date), Month(Date), 0)) - Day(mydob) + Day(Date)
                    Case False
                        m = -Month(mydob) - 12 * (tempdate > sysdate) + Month(Date)
                        d = Day(Date) - Day(mydob)
                End Select
    Case Else
                y = Year(sysdate) - Year(mydob)
                Select Case Day(mydob) > Day(Date)
                    Case True
                           
                        m = Month(Date) - Month(mydob) - 1
                        d = Day(DateSerial(Year(Date), Month(Date), 0)) - Day(mydob) + Day(Date)
                    Case False
                        m = Month(Date) - Month(mydob)
                        d = Day(Date) - Day(mydob)
                End Select
       
End Select
MsgBox "Your Age is" & y & " years " & m & "months" & d & "days"
End Sub

Tuesday, July 2, 2013

Remote Connection for SQL Server

Dim rec As New ADODB.Recordset
Dim con As New ADODB.Connection
Dim col As Long, row As Long

con_string = "DRIVER={MySQL ODBC 3.51 Driver};user=internalros;password=internalros;database=TBS;server=206.71.169.000;option=18475"
con.ConnectionString = con_string
con.Open