2003 to 2007 Commandbars
An MS guide to help you with the transition from 2003 to 2007
http://office.microsoft.com/en-us/access/HA102388991033.aspx
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
Idle Backup
Here is a simple way to keep your important documents and data backed up
Creating Excel files from MS Access
This routine is used to create an inventory forecast, which displays a 52 week forecast based on Sales orders MRP forecast and scheduled PO’s.
Function OpenWritetoXLS_QCS(tmpFiletoOpen, tmpFirstWeek, tmpLastWeek)
Dim objXL As Object
Dim strWhat As String, boolXL As Boolean
Dim objWkb As Object
Dim objSht As Object
Dim rst As Recordset, tmpRange, tmpRangeCount, tmpGonePast, tmpPosition, tmpOffset, I, tmpColumn
tmpGonePast = False
Set rst = CurrentDb.OpenRecordset("Select * from tblTmpXLFile order by Id") ' this is my access table that contains the records I want to insert into excel
If rst.RecordCount > 0 Then
rst.MoveFirst
Else
Set rst = Nothing
MsgBox ("Nothing to export to excel")
Exit Function
End If
tmpRange = ""
If fIsAppRunning("Excel") Then
Set objXL = GetObject(, "Excel.Application")
boolXL = False
Else
Set objXL = CreateObject("Excel.Application")
boolXL = True
End If
'now open file
With objXL
.Visible = True
Set objWkb = .Workbooks.Open(tmpFiletoOpen)
On Error Resume Next
Set objSht = objWkb.Worksheets("SHEETNAME")
If Not Err.Number = 0 Then
Set objSht = objWkb.Worksheets.Add
objSht.Name = "SHEETNAME"
End If
objWkb.Worksheets("SHEETNAME").Activate
objSht.Range("C1").Select
objXL.ActiveCell.offset(0, 0) = tmpFirstWeek
Err.Clear
On Error GoTo 0
tmpRangeCount = 1
With objSht
Do While Not rst.EOF
tmpPosition = rst!Cellref ' this notes the line within the Excel model that I want to populate
'reset to new position
Select Case tmpPosition
Case 6
.Range("B4").Select
tmpOffset = 3
Case 8
.Range("B5").Select
tmpOffset = 4
Case 9
.Range("B6").Select
tmpOffset = 5
Case 20
.Range("B12").Select
tmpOffset = 11
Case 30
.Range("B13").Select
tmpOffset = 12
Case 35
.Range("B14").Select
tmpOffset = 13
End Select
'Find out what row we should go to
tmpColumn = Val(rst!rptLabel)
tmpColumn = tmpColumn - tmpFirstWeek + 1
If Val(rst!rptLabel) = 0 Then
objXL.ActiveCell.offset(0, 0) = rst!FIELDNAME
Else
objXL.ActiveCell.offset(0, tmpColumn) = rst!FIELDNAME
End If
rst.MoveNext
Loop
End With
'update Parameters
Set objSht = objWkb.Worksheets("Parameters")
If Not Err.Number = 0 Then
Set objSht = objWkb.Worksheets.Add
objSht.Name = "Parameters"
End If
objWkb.Worksheets("Parameters").Activate
objSht.Range("A1").Select
objXL.ActiveCell.offset(0, 0) = "Year"
objXL.ActiveCell.offset(0, 1) = Forms![frmExport]![txtYear]
objXL.ActiveCell.offset(1, 0) = "Overdue Week"
objXL.ActiveCell.offset(1, 1) = Forms![frmExport]![txtOverDue]
objXL.ActiveCell.offset(2, 0) = "Start of Month"
objXL.ActiveCell.offset(2, 1) = Forms![frmExport]![txtStartofMonth]
objXL.ActiveCell.offset(3, 0) = "First Week"
objXL.ActiveCell.offset(3, 1) = Forms![frmExport]![txtFirstWeek]
objXL.ActiveCell.offset(3, 0) = "Last Week"
objXL.ActiveCell.offset(3, 1) = Forms![frmExport]![txtLastWeek]
End With
objWkb.Close savechanges:=True
Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing
Set rst = Nothing
End Function
Access Reports Search and Replace Headers
I had the opportunity to use Rickworlds search and replace utility again today, this product pays for itself immediately , or course if I was designing the app now I would drive the report heading from a table.
Syspro Server Move
We move server for Syspro version 6 recently and had to update 40 users ODBC connections. The easiest way to complete this was to fix the odbc setting on one computer , then export the registry for the ODBC setting. We moved that exported reg file to our server and sent all Syspro users a link to the registry file which updated the PC’s.
This is a sample of the file contents – you would need to change “YOURSERVER”
Windows Registry Editor Version 5.00
[HKEY_LOCAL_MACHINESOFTWAREODBCODBC.INISyspro6]
“Driver”=”C:\WINDOWS\system32\tsodbc32.dll”
“Description”=”Live”
“Server”=”YOURSERVER”
“Port”=”7000”
“Timeout”=”100”
We also had an issue with DCOM on the server, when enabling business object. The server was MS 2003 and the only way to get the system to operate was to make to posting user an administrator. This was documented in a tech PDF from syspro as noted below. If you know of any other solution please leave me a comment – thanks
Remote calls made by certain users fail
Cause
Changes introduced in Service Pack 1 (SP1) of Windows 2003 Server has resulted in the
failure of remote calls made by users who are not members of either the Administrators
or Distributed COM Users groups on the server.
Remedy
You need to configure the account permissions for remote access to the server (review
the procedure: Configuring account permissions for remote server access).
Alternatively you can add the user that is being used to run the application, to the DCOM
User group on the server. This group should have all of the required permissions
Configuring account permissions for remote server access
The following steps describe how to configure remote access permissions for users who
are not members of the Administrator or DCOM user groups on the server.
1. Launch the Component Services utility (Control Panel > Administrative Tools >
Component Services).
2. Open the My Computer Properties window.
a. Select the Component Services node.
b. Expand the Computers node.
c. Right-click My Computer.
d. Select Properties from the shortcut menu.
3. Configure the required access permissions.
a. Select the Security tab.
b. Select Edit Limits at the Access Permissions field.
c. Add the account that is being used to run the application via DCOM.
d. Enable the Allow option against the Remote Access option.
e. Select OK.
4. Configure the required launch and activation permissions.
a. Select Edit Limits at the Launch and Activation Permissions field.
b. Add the account that is being used to run the application via DCOM.
c. Enable the Allow option against the Remote Launch and Remote Activation
options.
d. Select OK.
5. Apply your selections.
6. Exit the utility.
Remote Desktop on XP
I spent too much time trying to get Remote Desktop installed onto a PC when it was already there but , for some unknown reason, the icon was missing.
Eventually I found this link and it allowed me to create a shortcut and restore the setting
