Scheduling Access Jobs

I use this code to determine the time set a status label and run some code. These program are opened using a scheduler from splinterware. This action is executed when the form is opened and will automatically close the database when finished. In this sample it runs the reports between 10pm and 11pm.

If Val(Left(Format(Now(), “hh:ss”), 2)) >= 22 And Val(Left(Format(Now(), “hh:ss”), 2)) < 23 Then
Me.txtStatus.Caption = “Running Auto Reports”
Call MakeReports
DoCmd.Quit
End If

testing

Opening IE from Excel

To open a web page in a seperate window, call this function with your URL – for example openbrowser(“http://www.e-ms.ie”)

Function OpenBrowser(tmpURL)
   Dim Browser As Object
    Set Browser = CreateObject("InternetExplorer.Application")
    Browser.Navigate (tmpURL)
    Browser.StatusBar = False
    Browser.Toolbar = False
    Browser.Visible = True
    Browser.Resizable = False
    Browser.AddressBar = False
End Sub

Date Difference in Excel

I have used datediff in access and vba but didnt not know that excel had the function DateDif which is very useful function in pay budgeting models.

See the link here for details

Date Calculations in VBA

I have picked up a number of date function from the web over the years and added some changes for my own use. These pick be useful for your projects

'----------------------------------------------------------------------
' FUNCTION: BeginLastMonth
' PURPOSE  : Returns the last calendar day of last month
'----------------------------------------------------------------------
Function BeginLastMonth()
BeginLastMonth = DateAdd("m", -1, DateSerial(Year(Date), Month(Date), 1))
End Function

'----------------------------------------------------------------------
' FUNCTION: BeginNextMonth
' PURPOSE  : Returns the first day of next month
'----------------------------------------------------------------------
Function BeginNextMonth()
BeginNextMonth = DateAdd("m", 1, DateSerial(Year(Date), Month(Date), 1))
End Function

'----------------------------------------------------------------------
' FUNCTION: BeginThisMonth
' PURPOSE  : Returns the first day of the current month.
'----------------------------------------------------------------------
Function BeginThisMonth()
BeginThisMonth = DateSerial(Year(Date), Month(Date), 1)
End Function

'----------------------------------------------------------------------
' FUNCTION: EndofMonth
' PURPOSE  : Returns the date of the last day of a month/year combination.
'----------------------------------------------------------------------
Function EndofMonth(Vdate) As Variant

If IsNull(Vdate) Then Exit Function

EndofMonth = DateAdd("M", 1, DateSerial(Year(Vdate), Month(Vdate), 1)) - 1

End Function

Function EndofThisMonth()
EndofThisMonth = DateAdd("m", 1, DateSerial(Year(Date), Month(Date), 1)) - 1
End Function

Function EndOfWeek(D As Variant, Optional FirstWeekday As Integer) As Variant
'
' Returns the date representing the last day of the current week.
'
' Arguments:
' D            = Date
' FirstWeekday = (Optional argument) Integer that represents the first
' day of the week (e.g., 1=Sun..7=Sat).
'
If IsMissing(FirstWeekday) Then 'Sunday is the assumed first day of week.
  EndOfWeek = D - WeekDay(D) + 7
Else
  EndOfWeek = D - WeekDay(D, FirstWeekday) + 7
End If
End Function

Function StartOfWeek(D As Variant, Optional FirstWeekday As Integer) As Variant
'
' Returns the date representing the last day of the current week.
'
' Arguments:
' D            = Date
' FirstWeekday = (Optional argument) Integer that represents the first
' day of the week (e.g., 1=Sun..7=Sat).
'
If IsMissing(FirstWeekday) Then 'Sunday is the assumed first day of week.
  StartOfWeek = D + WeekDay(D) - 7
Else
  StartOfWeek = D + WeekDay(D, FirstWeekday) - 7
End If
End Function

Function ElapsedDays(StartDate As Date, EndDate As Date) As Long

    ElapsedDays = Int(CSng(EndDate - StartDate))

End Function

Function DayName(tmpDay As Integer)
Select Case tmpDay
Case 1
    DayName = "Sunday"
Case 2
    DayName = "Monday"
Case 3
    DayName = "Tuesday"
Case 4
    DayName = "Wednesday"
Case 5
    DayName = "Thursday"
Case 6
    DayName = "Friday"
Case 7
    DayName = "Saturday"

End Select

End Function

Function Daynam(tmpDate As Date, Optional tmpS As Boolean)
Dim Day, Dat
tmpFirstDay = GetPref("First Day of Week")
If IsNull(tmpFirstDay) Then
   tmpFirstDay = GetPref("First Day of Week")
End If
Select Case tmpFirstDay
Case 0 ' Sunday
   Day = Array("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday")
Case 1 ' Sunday
   Day = Array("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday")
Case 2 ' Monday
   Day = Array("Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday")
Case 3 ' Tuesday
   Day = Array("Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday", "Monday")
Case 4 ' Wednesday
   Day = Array("Wednesday", "Thursday", "Friday", "Saturday", "Sunday", "Monday", "Tuesday")
Case 5 ' Thursday
   Day = Array("Thursday", "Friday", "Saturday", "Sunday", "Monday", "Tuesday", "Wednesday")
Case 6 ' Friday
   Day = Array("Friday", "Saturday", "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday")
Case 7 ' Saturday
   Day = Array("Saturday", "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday")
End Select

If tmpS Then
    Daynam = Left(Day(WeekDay(tmpDate)), 3)
Else
    Daynam = Day(WeekDay(tmpDate))
End If
End Function

Function getFday()
If IsNull(tmpFirstDay) Or IsEmpty(tmpFirstDay) Then
   tmpFirstDay = GetPref("First Day of Week")
End If
getFday = Val(tmpFirstDay)
End Function

Making your wordpress site smartphone ready

Check this out http://www.bravenewcode.com/products/wptouch/

Its a brillant plugin for wordpress which serves up a different theme when viewed on a smartphone and your regular web site , check this site out on your touch phone..

Creating an AIB Credits transfer file in VBA

This is the code I use to create an IBB transfer file, this can be linked to Sage, Syspro, Intact or any Accounting system which allow an ODBC connection. This contains a fe functions such as Getpref which pulls preference data from another table. These can be replaced with static data or your own functions.

The first part makes the the payee file….


Function CreatePayeeFile()
On Error GoTo Errorhandler

DoCmd.Hourglass True

Dim db As Database
Dim rst As Recordset
Dim SqlStr  As String
Dim myfile As Integer, tmpStr As String
Dim tmpfile As String, tmpPath As String

Set db = CurrentDb()
Set rst = db.OpenRecordset("qryPayeeExport")

'assign variables
'file
myfile = FreeFile
'check file name and path
If Len(GetPref("Payee File Name") & "") = 0 Then
    MsgBox ("File name required, please review setup details")
    GoTo Exit_Func
Else
    tmpPath = GetPref("Export File Path")
    tmpfile = GetPref("Payee File Name")
End If

If rst.RecordCount > 0 Then
    'move to the first record
    rst.MoveFirst
    'open the file for output
    Open (tmpPath & "" & tmpfile) For Output As myfile
    Do While Not rst.EOF
        tmpStr = Chr(34) & rst!V_Payee & Chr(34) & ","
        tmpStr = tmpStr & Chr(34) & rst!V_VendorID & Chr(34) & ","
        tmpStr = tmpStr & Chr(34) & rst!V_Name & Chr(34) & ","
        tmpStr = tmpStr & Chr(34) & rst!V_Address & Chr(34) & ","
        tmpStr = tmpStr & Chr(34) & rst!V_Phone & Chr(34) & ","
        tmpStr = tmpStr & Chr(34) & rst!V_Fax & Chr(34) & ","
        tmpStr = tmpStr & Chr(34) & rst!V_Telex & Chr(34) & ","
        tmpStr = tmpStr & Chr(34) & rst!V_Bank_Name & Chr(34) & ","
        tmpStr = tmpStr & Chr(34) & rst!V_Bank_Code_Type & Chr(34) & ","
        tmpStr = tmpStr & Chr(34) & rst!V_Bank_Code & Chr(34) & ","
        tmpStr = tmpStr & Chr(34) & rst!V_Account_Number & Chr(34) & ","
        tmpStr = tmpStr & Chr(34) & rst!V_International & Chr(34) & ","
        tmpStr = tmpStr & Chr(34) & rst!V_EDIFact_ID & Chr(34) & ","
        tmpStr = tmpStr & Chr(34) & rst!V_EDIFACT_Qualifier & Chr(34) & ","
        tmpStr = tmpStr & Chr(34) & rst!V_Vendor_Ref & Chr(34) & ","
        Print #myfile, tmpStr
        rst.MoveNext
    Loop
    'MsgBox ("File Export Complete")
'Else
    'MsgBox ("No Payee Records to Export")
End If
 
Exit_Func:

Set db = Nothing
Set rst = Nothing
DoCmd.Hourglass False
Close #myfile

Exit Function

Errorhandler:
MsgBox "An Error has Occurred " & vbCrLf & _
        "Error Number :" & Err.Number & vbCrLf & _
        "Details :" & Err.Description
        GoTo Exit_Func
        

End Function

The second part creates the payee file

Function CreatePaymentFile()
On Error GoTo Errorhandler

DoCmd.Hourglass True

Dim db As Database
Dim rst As Recordset
Dim SqlStr  As String
Dim myfile As Integer, tmpStr As String, tmpVer As String
Dim tmpfile As String, tmpPath As String, tmpLine As String, tmpComma
tmpComma = ","
Set db = CurrentDb()
Set rst = db.OpenRecordset("qryPaymentFile")
tmpVer = GetPref("AIB Program Version")

'increment the payment run to get a new run number
SetPref "Payment File Name", GetPref("Payment File Name") + 1, "Program", "System"

'assign variables
'file
myfile = FreeFile
'check file name and path
If Len(GetPref("Payment File Name") & "") = 0 Then
    MsgBox ("Payment File name required, please review setup details")
    GoTo Exit_Func
Else
    tmpPath = GetPref("Export File Path")
    tmpfile = right("00000000" & GetPref("Payment File Name"), 8) & ".imp"
End If

If rst.RecordCount > 0 Then
    'move to the first record
    rst.MoveFirst
    'open the file for output
    Open (tmpPath & "" & tmpfile) For Output As myfile
    Do While Not rst.EOF
        tmpLine = ""
        tmpLine = tmpLine & rst!PY_Payer & tmpComma                                   'field 1
        tmpLine = tmpLine & "EUR" & tmpComma                                          'field 2
        tmpLine = tmpLine & "WT" & tmpComma                                           'field 3
        tmpLine = tmpLine & "SHA" & tmpComma                                          'field 4
        tmpLine = tmpLine & rst!PY_Currency & tmpComma                                'field 5
        tmpLine = tmpLine & rst!PY_Amount & tmpComma                                  'field 6
        tmpLine = tmpLine & Format(rst!PY_ValueDate, "DD-MM-YYYY") & tmpComma         'field 7
        tmpLine = tmpLine & Left(RegReplace(rst!V_Name) & "", 35) & tmpComma          'field 8
        tmpLine = tmpLine & Left(RegReplace(rst!V_Address) & "", 35) & tmpComma       'field 9
        tmpLine = tmpLine & "" & tmpComma   'second address line blank                'field 10
        tmpLine = tmpLine & rst!PY_Reference & tmpComma                               'field 11
        tmpLine = tmpLine & "" & tmpComma   'optional unique ref                      'field 12
        tmpLine = tmpLine & rst!V_Account_Number & tmpComma   'Bank account           'field 13
        
        If IsNumeric(Left(rst!V_Bank_Code, 1)) = False Then
            tmpLine = tmpLine & rst!V_Bank_Code & tmpComma   'Bank code               'field 14
            tmpLine = tmpLine & "" & tmpComma   'bank clearing code if no iban        'field 15
            tmpLine = tmpLine & "" & tmpComma   'party bank clearing code if 15 is p  'field 16
        Else
            tmpLine = tmpLine & "" & tmpComma   'Bank code               'field 14
            tmpLine = tmpLine & rst!V_Bank_Code & tmpComma   '                   'field 15
            tmpLine = tmpLine & rst!V_Bank_Code_Type & tmpComma   'party bank clearing code if 15 is pop'field 16
        End If
        tmpLine = tmpLine & rst!V_CountryCode & tmpComma   'bank country code         'field 17
        tmpLine = tmpLine & "" & tmpComma   'optional                                 'field 18
        tmpLine = tmpLine & "" & tmpComma   'optional                                 'field 19
        tmpLine = tmpLine & "" & tmpComma   'optional                                 'field 20
        tmpLine = tmpLine & "" & tmpComma   'optional                                 'field 21
        tmpLine = tmpLine & "" & tmpComma   'optional                                 'field 22
        tmpLine = tmpLine & ""              'optional                                 'field 23
                
        
        Print #myfile, tmpLine
        
        rst.MoveNext
    Loop
   If MsgBox("Print Reports ", vbYesNo) = vbYes Then
        DoCmd.OpenReport "your reports...."      
   End If
    MsgBox ("File Export Complete")
Else
    MsgBox ("No Payment Records to Export")
End If
 
Exit_Func:

Set db = Nothing
Set rst = Nothing

DoCmd.Hourglass False

Close #myfile

Exit Function

Errorhandler:
MsgBox "An Error has Occurred " & vbCrLf & _
        "Error Number :" & Err.Number & vbCrLf & _
        "Details :" & Err.Description
        GoTo Exit_Func
        

End Function

10+ reasons why IT pros hate Microsoft Access..

10+ reasons why IT pros hate Microsoft Access (but really shouldn’t)
This is a link to the article by Susan Harkins on TechRepublic.

Its an interesting read whatever side of the fence you are on

http://blogs.techrepublic.com.com/10things/?p=386

Idle Backup

Here is a simple way to keep your important documents and data backed up

http://idlebackup.nl/