Learn Microsoft Access Advanced Programming Techniques, Tips and Tricks.

Showing posts with label msaccess How Tos. Show all posts
Showing posts with label msaccess How Tos. Show all posts

Finding Last Day of Week

Introduction.

How to find the weekend date or first-day date of a week using the Current Date as input.  Or find the first/last-day date of any week by giving a date value as input.

This kind of calculation may become necessary to find the weekend date and use it as criteria in queries, filter data for viewing, or print Reports for sharing of information.

Wherever you need it you can use the following simple expression to find the week-end date of the current week:

The Simple Expressions

LastDayOfWeek = Date()-WeekDay(date())+7

If the current date is 14th June 2017 (or any date between 11 and 17 June 2017) then the value returned in variable LastDayOfWeek = 17th June 2017.

Example-1

To find the first-day date of the current week use the following method:

FirstDayOfWeek = date()-WeekDay(date())+1

Assuming the current date is 14th June 2017 (or any date between 11 and 17 June 2017) the first-day date of the week returned in variable FirstDayofWeek = 11th June 2017.

Example-2

By giving a specific date as input to the expression to find the last-day date of the week:

dtValue = #06/27/2017#
LastDayOfWeek = dtValue - WeekDay(dtValue)+7
Result: 1st July 2017

Example-3

If you would like to do it differently then try the following expression:

x = #06/27/2017#
'To find the last-day date of the Week:
LastDayofWeek = DateSerial(Year(Date()),1,1)+DatePart("ww",x)*7-1
Result: 1st July, 2017
'To find the first-day date of the Week.
FirstDayofWeek = DateSerial(Year(Date()),1,1)+DatePart("ww",x)*7-7
Result: 25th June, 2017

WeekLastDay Function

Define it as a Function in a VBA Module and call it wherever you want, with a date value as the parameter. The Sample Function code is given below:

Public Function WeekLastDay(ByVal dtVal As Date) As Date
'Date value as input
   WeekLastDay = dtVal - WeekDay(dtVal) + 7
End Function

WeekFirstDay Function

Public Function WeekFirstDay(ByVal dtVal As Date) As Date 
'Date value as input 
    WeekFirstDay = dtVal - WeekDay(dtVal) + 1 
End Function
Share:

Rounding Function MRound of Excel

Introduction.

Normally we round numbers in calculations when the fractional part is 0.5 or more to 1 (the next highest integer) or truncate it together. But, there are times that this fractional part itself is rounded to a certain level so that it can be used for disbursement of money, like wages.

For example, in Currencies when the value ends up in 15 cents or 30 cents they should be rounded to 25 cents, and 50 cents respectively, for determining the requirement of the correct number and denominations of Coins for disbursement. If we decide we need only 50 Cents Coins then a value of 25 Cents or more should be rounded to 50 Cents and less than 25 Cents to zero.

So, we need a function that can accept a value as precision and find multiples of that value and when the remainder value is half or more of the precision value it should be rounded to the next level. Not necessary that it should be a fractional value it can be any value as precision.

In MS-Access we have a Round() Function that will only round the Double Precision numbers into the required number of Decimal Places or to the next integer level applying the normal rules that we are already familiar with. There is a Worksheet Function MRound() in MS-Excel that can do these kinds of calculations, but found nothing like that in MS-Access. We cannot go to Excel when we want this in Access.

The MRound Function

We will write an MRound() Function in Access with the same name.

So here it is:

Public Function MRound(ByVal Number As Double, ByVal Precision As Double) As Double
Dim Y As Double

On Error GoTo MRound_Err

   Y = Int(Number / Precision) * Precision
   MRound = IIf(((Number - Y) / Precision * 100 + 0.1) >= 50, Y + Precision, Y)

MRound_Exit:
Exit Function

MRound_Err:
MsgBox Err.Description, , "MRound()"
MRound = 0
Resume MRound_Exit
End Function

Save the Function and do Test Runs.

Copy and paste the above Code into a Global Module of your Database and save the Module.

Open the Debug Window (Ctrl+G) to try it out directly.

Sample Runs:

? Mround(123.3,.2)

Result: 123.4

? Mround(123.24,.5)

Result: 123

? Mround(123.25,.5)

Result: 123.5

? Mround(123.74,.5)

Result: 123.5

? Mround(123.75,.5)

Result: 124

? Mround(10,3)

Result: 9

? Mround(11,3)

Result: 12

Add to your Function Library

If you would like to share this Function across your Other MS-Access Databases then create a Library Database with the Function in it and set a Reference to the Library Database through Tools- ->References in VBA Window.

Earlier Post Link References:

  1. Roundup Excel Function in MS Access
  2. Proper Excel Function in Microsoft Access
  3. Appending Data from Excel to Access
  4. Writing Excel Data Directly into Access
  5. Printing MS-Access Report from Excel
  6. Copy Paste Data From Excel to Access2007
  7. Microsoft Excel-Power in MS-Access
  8. Rounding Function MROUND of Excel
  9. MS-Access Live Data in Excel
  10. Access Live Data in Excel- 2
  11. Opening Excel Database Directly
  12. Create Excel, Word Files from Access
Share:

Sum Min Max Avg ParamArray

Introduction.

I know your immediate response after looking at the title will be, "I know all those things, tell me something that I don't know about". Well, if you haven't come across the last item (that is an odd one) in the Title before, then that is what I am trying to do here, read on. The first four words are very familiar to us they are Built-in Functions in MS-Access and Worksheet Functions in Excel.

We will catch up with the last one later, after checking the usage of Min() Function (will represent the first four items in the title) in Excel and why we have some difficulty with it in MS-Access when compared with Microsoft Excel.

Difference between Excel and Access

We are not forgetting the other Functions DCount(), DSum(), DMin(), DMax() and DAvg() of Access at all.

Let us look at the usage of the Min() Worksheet Function in Excel. It can find the minimum Value from a Range of Cells in a Single Column, from a Row of Cells across Columns, or from a Range of Cells spread over several Columns and Rows.

But, when we come back to MS-Access the Min() function can be used only in a single column (on a single Field) of a Query and in Header/Footer Sections of Forms or Reports. Then what do we do to find the Minimum value from more than one Field?

Have a look at the sample table given below to get the gravity of the issue we are here.

We have received Quotations for Electronic Items from three different Suppliers, and we need to know which one is the lowest and from which Supplier. In this case, our Min() Function has no use here unless we re-organize the above data in the following format:

To get the required result out of this data, we need two Queries and we will ignore the duplication of Descriptions, Supplier Names, the Table size in Records, etc., for now.

  1. Need one Total Query to the group on the Desc field and the Min() Function to find the minimum value from the Values Field.
  2. Need a second Query, using the first Query and the Table above as Source, JOINed on Desc and MinOfValues Columns of the Total Query with the Desc and Values Fields of the Table to pick all the records from the Table matching with minimum quoted values and Description.

The ParamArray Method

I consider these steps are excessive work and I know you will agree too. Instead, we can write a User Defined Function with the use of ParamArray and pass the Field Names to the Function and find the Minimum Value from the list. Here is a simple Function with the use of the ParamArray declaration to find the Minimum Value from a List of Values passed to it.

Public Function myMin(ParamArray InputArray() As Variant) As Double
'------------------------------------------------------------------
'Author : a.p.r. pillai
'Date   : November-2008
'URL    : www.msaccesstips.com
'All Rights Reserved by www.msaccesstips.com
'------------------------------------------------------------------
Dim arrayLength As Integer, rtn As Double, j As Integer

'calculate number of elements in Array
arrayLength = UBound(InputArray())

'initialize Null values to 0
For j = 0 To arrayLength
   InputArray(j) = Nz(InputArray(j), 0)
Next
'initialize variable with 1st element value
'or if it is zero then a value with high magnitude
rtn = IIf(InputArray(0) = 0, 9999999999#, InputArray(0))

For j = 0 To arrayLength
    If InputArray(j) = 0 Then
 GoTo nextitem
   If InputArray(j) < rtn Then
        rtn = InputArray(j)
    End If
nextitem:
Next

myMin = rtn
End Function

Copy and Paste the above Code into a Global Module and save it.

A few simple rules must be kept in mind while writing User Defined Functions using the ParamArray declaration in the Parameter list of the Function.

  1. While declaring the Function, the Parameter Variable InputArray() (or any other name you prefer) must be declared with the keyword ParamArray, in place of ByRef or ByVal we normally use to declare parameters to functions.
  2. The Data Type must be a Variant type.
  3. The ParamArray declaration must be the last item in the Parameter list if the UDF accepts more than one Parameter.
  4. The Optional parameter declarations should not appear before the ParamArray declaration.
  5. Since the data type is Variant it can accept any type of value.

With the use of the above myMin() Function, we have created a Query on the first Table given above. The SQL and the resulting image of the Query in Datasheet View are given below.

SELECT MaterialQuote.Desc,
 MaterialQuote.Supplier1,
 MaterialQuote.Supplier2,
 MaterialQuote.Supplier3,
 mymin([supplier1],
[supplier2],
[supplier3]) AS Minimum,
 IIf([minimum]=[supplier1],"Supplier1",IIf([minimum]=[supplier2],"Supplier2",IIf([minimum]=[supplier3],"Supplier3",""))) AS Quote
FROM MaterialQuote;

In the above example, we have used only three Field Values to pass to the Function and these can vary depending on your requirement.


Modified Version of VBA Code

A modified version of the same function is given below that accepts a Calculation Type value (range 0 to 3) as the first Parameter and depending on that we can find the Summary, Minimum, Maximum, or Average values passed to it through the InputArray() Variable.

Option Compare Database

Enum SMMA
    accSummary = 0
    accMinimum = 1
    accMaximum = 2
    accAverage = 3
End Enum

Public Function SMMAvg(ByVal calcType As Integer, ParamArray InputArray() As Variant) As Double
'------------------------------------------------------------------------
'calType : 0 = Summary'        : 1 = Minimum
'        : 2 = Maximum'        : 3 = Average
'------------------------------------------------------------------------
'Author  : a.p.r. pillai'Date    : November 2008
'URL     : www.msaccesstips.com
'All Rights Reserved by www.msaccesstips.com
'------------------------------------------------------------------------
Dim rtn As Double, j As Integer, arrayLength As Integer
Dim NewValue As Variant

On Error GoTo SMMAvg_Err

If calcType < 0 Or calcType > 3 Then
     MsgBox "Valid calcType Values 0 - 3 only", , "SMMAvg()"
     Exit Function
End If

arrayLength = UBound(InputArray())
'Init Nulls, if any,  to 0
For j = 0 To arrayLength
   InputArray(j) = Nz(InputArray(j), 0)
Next

For j = 0 To arrayLength
    NewValue = InputArray(j)
    'skip 0 value
    If NewValue = 0 Then
 GoTo nextitem
    End If
    Select Case calcType
    'Add up values for summary/average
        Case accSummary, accAverage
            rtn = rtn + NewValue
        Case accMinimum
            rtn = IIf(NewValue < rtn, NewValue, rtn)
            rtn = IIf(rtn = 0, 9999999999#, rtn)
        Case accMaximum
            rtn = IIf(NewValue > rtn, NewValue, rtn)
    End Select
nextitem:
Next

'Calc Average
If calcType = accAverage Then
   rtn = rtn / (arrayLength + 1)
End If

SMMAvg = rtn

SMMAvg_Exit:
Exit Function

SMMAvg_Err:
MsgBox Err.Description, , "SMMAVG()"
SMMAvg = 0
Resume SMMAvg_Exit
End Function

The Function name was defined using the first letters of the Calculation Types that the Function can perform and I hope you like it too.

When any of the values in the InputArray() element is Zero then that is ignored and will not be taken as the minimum value.

Sample Runs on Immediate Window:

? SMMAvg (0,0,10,5,7) 'Summary
 Result: 22 

? SMMAvg (1,0,10,5,7) 'Minimum value from 0,10,5,7
 Result: 5
 
? SMMAvg (2,0,10,5,7) 'Maximum value from 0,10,5,7
 Result: 10 
 
? SMMAvg (3,0,10,5,7) 'Average
 Result: 5.5 
  

We can use this Function in Text Boxes on Forms,  Reports, or from other Controls. Use it at your own risk.

Share:

MICROSOFT ACCESS HOW TOS

Share:

DISPLAY PATH AND FILE INFO

Displaying File Path and File Attributes

Copy and paste the following code into the Standard Module of your project. Replace the text file reference: C:\mytext.txt with one of your own files on disk.

Sub ShowFileAccessInfo2() 
Dim fs, d, f, s  
On Error Goto ShowFileAccessInfo2_Err

Set fs = CreateObject("Scripting.FileSystemObject") 
Set f = fs.Getfile("C:\mytext.txt")  
s = UCase(f.Path) & vbCrLf 
s = s & "Created: " & f.DateCreated & vbCrLf 
s = s & "Last Accessed: " & f.DateLastAccessed & vbCrLf 
s = s & "Last Modified: " & f.DateLastModified & vbCrLf 
s = s & "File Size : " & f.Size & " Bytes."  

MsgBox s, 0, "File Access Info"  

ShowFileAccessInfo2_Exit: 
Exit Sub  

ShowFileAccessInfo2_Err: 
MsgBox Err.Description,,"ShowFileAccessInfo2" 
Resume ShowFileAccessInfo2_Exit  
End Sub 

You may run the program directly from the Debug Window to test it.

Courtesy: Microsoft Access Help Documents.

Go to >> HOW TOs Main Page

Share:

RENAME FILE USING FILESYSTEMOBJECT


FILESYSTEM OBJECT.

Renaming a file and displaying Drive & File Information

Copy and paste the following code into a Standard Module in your Project.

Sub ShowFileAccessInfo() 
Dim fs, f, fn  
On Error GoTo ShowFileAccessInfo_Err
Set fs = CreateObject("Scripting.FileSystemObject") 
Set f = fs.Getfile("C:\mytext.txt") 
fn = f.Name & " on Drive " & UCase(f.Drive) & vbCrLf  
'renames the file named c:\mytext.txt as yourtext.txt  

f.Name = "yourtext.txt" 
fn = fn & "New Name: " & f.Name & vbCrLf 
fn = fn & "Created: " & f.DateCreated & vbCrLf 
fn = fn & "Last Accessed: " & f.DateLastAccessed & vbCrLf 
fn = fn & "Last Modified: " & f.DateLastModified  

MsgBox fn, 0, "File Access Info"  

ShowFileAccessInfo_Exit: 
Exit Sub
  
ShowFileAccessInfo_Err: 
MsgBox Err.Description, , "ShowFileAccessInfo" 
Resume ShowFileAccessInfo_Exit  
End Sub 

Change the program lines wherever the sample text file reference: c:\mytext.txt is appearing in the code with one of your own text file pathnames.

Next >> Display Path and File Info.

Share:

CREATE TEXT FILE FROM MSACCESS

Creating a Text File from Microsoft Access.

The FileSystemObject Object provides access to the computer's file system.

The following code illustrates how the FileSystemObject is used to return a TextStream object that can be read from or written to.

Syntax: Scripting.FileSystemObject

Example:

Sub CreateTextFile()
Dim fs As Object, txt
On Error goto CreateTextFile_Err
Set fs = CreateObject("Scripting.FileSystemObject")
Set txt = fs.CreateTextFile("C:\mytest.txt", True)
txt.writeline ("This is a test.")
txt.Close

CreateTextFile_Exit:
Exit Sub

CreateTextFile_Err:
Msgbox Err.Description,,"CreateTextFile"
Resume CreateTextFile_Exit
End Sub 

In the code shown above, the CreateObject function returns the FileSystemObject (fs). The CreateTextFile method then creates the file as a TextStream object, txt, and the WriteLine method writes a line of text to the created text file. The Close method flushes the buffer and closes the file.

Reading From a Text File.

Reading Text File using FileSystemObject Example:

Sub ReadTextFile()
Dim fs As Object, txt, txtline

On Error Goto ReadTextFile_Err

Set fs = CreateObject("Scripting.FileSystemObject")
Set txt = fs.opentextfile("C:\mytest.txt")
txtline = txt.readline
txt.Close

MsgBox "C:\mytest.txt File contents : " & txtline

ReadTextFile_Exit:
Exit Sub

ReadTextFile_Err:
Msgbox Err.Description,,"ReadTextFile"
Resume ReadTextFile_Exit
End Sub 

Next >> Rename a File.

Share:

CREATE EXCEL WORD FILE FROM ACCESS

Introduction

Create an Excel File or a Word Document from Microsoft Access and write information into it. Every application that supports Automation provides at least one type of object. For example, a word processing application may provide an Application object, a Document object, and a Toolbar object. To create an ActiveX object, assign the object returned by CreateObject to an object variable.

Create an MS-Word File.

The first example creates a Word File and writes some text into it, and saves it with a name.

Public Sub CreateWordDoc() 
Dim WordObj As Object
  
On Error goto CreateWordDoc_Err

Set WordObj = CreateObject("word.application")
With WordObj
   .Application.Visible = True
   .Application.Documents.Add "Normal", , 0, True
   .ActiveDocument.Content = "THIS IS MY TEST DOCUMENT."
   .Application.ActiveDocument.SaveAs "C:\myDocument2.doc"
   .Application.Quit
End With
Set WordObj = Nothing

CreateWordDoc_Exit:
Exit Sub

CreateWordDoc_Err:
msgbox Err.Description,,"CreateWordDoc"
Resume CreateWordDoc_Exit
End Sub 

Creating an MS-Excel File

The Next example creates an Excel Worksheet and writes a line of text in Column A, Row 1, and saves it with a Name. This code starts the application by creating the object, in this case, a Microsoft Excel spreadsheet. Once an object is created, you reference it in code using the object variable you defined. You access properties and methods of the new object using the object variable, ExcelSheet, and other Microsoft Excel objects, including the Application object and the Cells collection.

Public Sub CreateExcelSheet()
Dim ExcelSheet As Object

On Error goto CreateExcelSheet_Err

Set ExcelSheet = CreateObject("Excel.Sheet")

With ExcelSheet
   .Application.Visible = True
   .Application.Cells(1, 1).Value = "This is Column A, row 1"
   .SaveAs "C:\TEST.XLS"
   .Application.Quit
End With

Set ExcelSheet = Nothing

CreateExcelSheet_Exit:
Exit Sub
CreateExcelSheet_Err:
Msgbox Err.Description,,"CreateExcelSheet"
Resume CreateExcelSheet_Exit
End Sub 

Next >> Create a Text File from Access.

Share:

IMPORT OBJECTS WITH VBCODE

Introduction.

Normally, you can manually import tables, queries, or other objects from another database by choosing File > Get External Data > Import in Microsoft Access. However, this task can also be automated using VBA code. The question of "How to do this using code?" often comes up in Microsoft Access user forums. I believe this solution will be helpful to those seeking a programmatic approach. Therefore, I’m sharing the code examples here for importing tables, queries, and forms separately.

Importing All Tables.

The next method imports all Tables from a Source database into the active database except the Microsoft Access System Tables.

Public Function Table Import() 
'----------------------------------------------------------------- 
'Function to Import Microsoft Access Tables from another Database 
'Author : a.p.r. pillai 
'Date : 02/12/2006 
'----------------------------------------------------------------- 
Dim wrkSpace As Workspace, db As Database, tbldef 
Dim strFile As String 
Dim ObjFilter As String  
'if conflict with existing object name then ignore 
' and import next object 
On Error Resume Next  
Set wrkSpace = DBEngine.Workspaces(0)  
'Check for Table Definitions in the Source database 
'and import all of them except System Tables.  
Set db = wrkSpace.OpenDatabase("c:\tmp\Sourcedb.mdb") 
For Each tbldef In db.TableDefs 
strFile = tbldef.Name  
'Filter out Microsoft Access System Tables. 
ObjFilter = left(strFile, 4) 
If ObjFilter <> "MSys" Then   
    DoCmd.TransferDatabase acImport, "Microsoft Access", "c:\tmp\Sourcedb.mdb", acTable, strFile, strFile, False
End If  
Next  
End Function 

Importing All Queries.

Next Function Imports all the Queries from the Source database into the current database.

Public Function QueryImport() 
'------------------------------------------------------------------ 
'Function to Import Microsoft Access Queries from another Database 
'Author : a.p.r. pillai 
'Date : 02/12/2006 
'------------------------------------------------------------------ 
Dim wrkSpace As Workspace, db As Database, QryDef 
Dim strFile As String  
'if conflict with existing object name then ignore 
'and import next object 
On Error Resume Next  
Set wrkSpace = DBEngine.Workspaces(0) 
'Check for Query Definitions in the Source database 
'and import all of them. 
Set db = wrkSpace.OpenDatabase("c:\tmp\Sourcedb.mdb") 
For Each QryDef In db.QueryDefs
 strFile = QryDef.Name
 DoCmd.TransferDatabase acImport, "Microsoft Access", "c:\tmp\Sourcedb.mdb", acQuery, strFile, strFile, False 
Next  
End Function 

Importing All Forms.

The ImportForms() Function Imports all the Forms from an external Microsoft Access database into the current Database.

Public Function ImportForms() 
'---------------------------------------------------------------- 
'Function to Import Microsoft Access Forms from another Database 
'Author : a.p.r. pillai 
'Date : 02/12/2006 
'---------------------------------------------------------------- 
Dim FRM As Variant, wrkSpace As Workspace 
Dim db As Database, strForm As String 
Dim ctr As Container  
'if conflict with existing object name then ignore 
'and import next object 
On Error Resume Next  
Set wrkSpace = DBEngine.Workspaces(0) 
Set db = wrkSpace.OpenDatabase("c:\tmp\Sourcedb.mdb") 
Set ctr = db.Containers("Forms") 
For Each FRM In ctr.Documents 
strForm = FRM.Name
 DoCmd.TransferDatabase acImport, "Microsoft Access", "c:\tmp\Sourcedb.mdb", acForm, strForm, strForm, False 
Next  
End Function 

Exporting All Forms

The ExportForms() Function Exports all the Forms into an external Microsoft Access database.

Public Function ExportForms() 
'---------------------------------------------------------------- 
'Function to Export Microsoft Access Forms into another Database 
'Author : a.p.r. pillai 
'Date : 02/12/2006 
'---------------------------------------------------------------- 
Dim cdb As Database 
Dim ctr As Container, doc, strFile As String  
'if conflict with existing object name then ignore 
'and import next object 
On Error Resume Next  
'Export all Forms from the current database into  
'the Target database 
Set cdb = CurrentDb 
Set ctr = cdb.Containers("Forms")  
For Each doc In ctr.Documents 
strFile = doc.Name 
  DoCmd.TransferDatabase acExport, "Microsoft Access", "c:\tmp\Targetdb.mdb", acForm, strFile, strFile, False 
Next  
End Function 

With little modifications to these Codes, they can be used for transferring objects between two external databases.

Next >> Create Excel File from Access.

Share:

PRESENTATION: ACCESS USER GROUPS (EUROPE)

Translate

PageRank

Post Feed


Search

Popular Posts

Blog Archive

Powered by Blogger.

Labels

Forms Functions How Tos MS-Access Security Reports msaccess forms Animations msaccess animation Utilities msaccess controls Access and Internet MS-Access Scurity MS-Access and Internet Class Module External Links Queries Array msaccess reports Accesstips WithEvents msaccess tips Downloads Objects Menus and Toolbars Collection Object MsaccessLinks Process Controls Art Work Property msaccess How Tos Combo Boxes Dictionary Object ListView Control Query VBA msaccessQuery Calculation Event Graph Charts ImageList Control List Boxes TreeView Control Command Buttons Controls Data Emails and Alerts Form Custom Functions Custom Wizards DOS Commands Data Type Key Object Reference ms-access functions msaccess functions msaccess graphs msaccess reporttricks Command Button Report msaccess menus msaccessprocess security advanced Access Security Add Auto-Number Field Type Form Instances ImageList Item Macros Menus Nodes RaiseEvent Recordset Top Values Variables Wrapper Classes msaccess email progressmeter Access2007 Copy Excel Export Expression Fields Join Methods Microsoft Numbering System Records Security Split SubForm Table Tables Time Difference Utility WScript Workgroup database function msaccess wizards tutorial Access Emails and Alerts Access Fields Access How Tos Access Mail Merge Access2003 Accounting Year Action Animation Attachment Binary Numbers Bookmarks Budgeting ChDir Color Palette Common Controls Conditional Formatting Data Filtering Database Records Defining Pages Desktop Shortcuts Diagram Disk Dynamic Lookup Error Handler External Filter Formatting Groups Hexadecimal Numbers Import Labels List Logo Macro Mail Merge Main Form Memo Message Box Monitoring Octal Numbers Operating System Paste Primary-Key Product Rank Reading Remove Rich Text Sequence SetFocus Summary Tab-Page Union Query User Users Water-Mark Word automatically commands hyperlinks iSeries Date iif ms-access msaccess msaccess alerts pdf files reference restore switch text toolbar updating upload vba code