Learn Microsoft Access Advanced Programming Techniques, Tips and Tricks.

MS-Access And Transfer SpreadSheet Command.

Introduction.

A very useful Command to transfer data between Microsoft Access and Excel using the Import/Export Options.  Here, we will concentrate on the Export aspect and what challenges we encounter after exporting the data, using some export Options out of several of them provided with this feature in MS-Access.

The simple VBA Command Syntax is:

Docmd.TransferSpreadsheet [Transfer Type],[SpreadSheet Type],[Input TableName/Query Name],[Output FilePath],True(HasFieldNames),Range,UseOA 

  1. The first parameter Transfer Type is either acImport or acExport.
  2. For the second parameter SpreadSheet Type, in-built Options are available from 0 to 10, as an enumerated list, including transfer to Lotus Worksheets as well.

    The Enumerated List is given below:

    1. acSpreadsheetTypeExcel12xml  -  10
    2. acSpreadsheetTypeExcel12  -  9
    3. acSpreadsheetTypeExcel9  -  8
    4. acSpreadsheetTypeExcel8  -  8
    5. acSpreadsheetTypeExcel7  -  5
    6. acSpreadsheetTypeExcel5  -  5
    7. acSpreadsheetTypeExcel4  -  6
    8. acSpreadsheetTypeExcel3  -  0
    9. acSpreadsheetTypeLotusWJ2  -  4
    10. acSpreadsheetTypeLotusWk4  -  7
    11. acSpreadsheetTypeLotusWk3  -  3
    12. acSpreadsheetTypeLotusWk1  -  2

    You can use either the Enumerated List item or the numeric value it represents as the second parameter.

  3. The input Table or Query Name must be the third parameter.

  4. Next, the Output File Path Name.

  5. Next, the parameter True indicates that the Field Names to be output as the first Row Value in the Worksheet.

  6. The optional Range parameter is used along with the acImport Option only.

  7. The last optional parameter UseOA is not defined and not used.

Sample Transfer-Spreadsheet Command

Docmd.TransferSpreadSheet acExport,acSpreadSheetTypeExcel12xml,”Products”,”C:\My Documents\Book1.xlsx”,True

The Option acSpreadsheetTypeExcel3 to 9 creates Excel File versions compatible with Excel 97 – 2003 format with .XLS extension, which can open in Excel 2007.  But, if we give the output file name with the .xlsx extension explicitly then the output file cannot be opened in Excel 2007 or in higher versions.

The acSpreadsheetTypeExcel12 Option creates an Excel File with .XLSB extension and opens in Excel 2007 and Higher Versions.  XLSB extension denotes that the workSheet is a Binary Coded File. When you have a large volume of records this format is ideal because of its reduced file size.

Option acSpreadsheetTypeExcel12xlm creates an Excel File with extension .xlsx and compatible with Excel 2007 and above.

The output option acSpreadSheetTypeExcel9 or an earlier version, when selected the output, doesn’t look attractive because of its old-fashioned Office Theme.  Like the sample Screenshot given below:

transfer SpreadSheet

We must open the output file in the current version of Excel and change the Format with the new Font and Font-size to make it look better and save it in the current version of the file.  Besides that if we explicitly add the .xlsx file extension,  to the target file parameter, assuming that the Target File will be created in Excel 2007 or higher Version Default Theme, the Excel file thus created will not open in Excel 2007 or higher versions.

But, with a small trick, we can solve all these problems and can save the output in the current version of Excel, whether it is 2007, 2010, 2013, or whatever version of Excel you have.  Doesn’t matter which version of WorkSheet Type you have selected in the TransferSpreadSheet command the output will be saved in the current version of Excel you have installed in your machine.

A Simple Solution.

  1. Create an Excel Workbook in the Current version of Excel and Save the file in the target location.

  2. Close the Workbook.

  3. Execute the above TransferSpreadSheet command with the saved Workbook file Pathname as the target file parameter.  The output worksheet will be saved in the target Workbook in a new Worksheet.

  4. When the WorkSheet is saved in the current Excel Version Workbook the Default Office Theme is automatically applied to the output WorkSheet and the Data Format looks better like the sample Image is given below:

We  written three slightly different functions to save the TransferSpreadSheet Command's output WorkSheet(s) in three different ways.

The Export2ExcelA() Function.

This Function Creates a Single WorkSheet as output in the Target WorkBook.

Public Function Export2ExcelA(ByVal xlFileLoc As String, ByVal QryORtableName As String) As String
On Error GoTo Export2ExcelA_Err
Dim tblName As String
Dim filePath As String
Dim xlsPath As String

Dim wrkBook As Excel.Workbook

'xlFileLoc = "D:\Blink\tmp2\"
'QryORtblName = "Products"

xlsPath = xlFileLoc & QryORtableName & ".xlsx"
If Len(Dir(xlsPath)) = 0 Then
    Set wrkBook = Excel.Workbooks.Add
        wrkBook.SaveAs xlsPath
        wrkBook.Close
End If
DoCmd.TransferSpreadSheet acExport, acSpreadsheetTypeExcel12Xml, QryORtableName, xlsPath, True

MsgBox "File: " & xlsPath & " Created ", , "Export2ExcelA()()"

Set wrkBook = Nothing
Export2ExcelA = xlsPath

Export2ExcelA_Exit:
Exit Function

Export2ExcelA_Err:
MsgBox Err & " : " & Err.Description, , "Export2ExcelA()"
Export2ExcelA = ""
Resume Export2ExcelA_Exit

End Function

The Export2ExcelA() Function needs two parameters. The output Excel file’s target Path is the first parameter.  The second parameter is the input Table/Query name as the second parameter.  In this example, the function creates a WorkSheet using the Products Table and saves the output WorkSheet in a Workbook.

At the beginning of the Code, it checks the presence of an Excel file on the Disk with the specified name in the transfer spreadsheet command.  If not found then create a new WorkBook in the Current Version of Excel, with the same name of the input table/query name. The Workbook is then closed. If the specified file exists then the Output Worksheet is saved in that workBook.

Suppose, we don’t create the current version of Excel WorkBook and provide it as the target file for the Excel WorkSheet then what will happen?  Let us take a look at it.

  • If  don’t specify the Excel file extension like C:\My Documents\Products and select the SpreadSheetxl9 output type option then the command creates a new Excel file with XLS extension like Products.XLS. 

  • If we explicitly give the .xlsx file extension in the pathname and the SpreadSheet output type selected is SpreadsheetTypexl9 then a Target Excel output file will be created with that file extension. But, the file will not open in Excel 2007 or in higher Versions.

  • But, the WorkBook C:\My Documents\myBook.xlsx if already exist then the output will be saved in that Workbook as a separate WorkSheet. In this case, the Worksheet will be formatted with the current Excel Version Default Office theme.

  • This is the reason why we are creating a new WorkBook in the current version of Excel and saves it to the target location in advance. After saving the file we must close it and give the reference in the TransSpreadSheet Output file Path parameter.

  • If the target Workbook is already in use then it will end up with an error message; Source File not found

In the next step, the Workbook Pathname is passed as a parameter to the TransferSpreadsheet command.

Separate WorkSheets in a Single WorkBook.

There are times we need to create separate worksheets,  for data grouped on some criteria for distribution.  These probably need as separate WorkSheets in a single WorkBook or each workSheet in a different WorkBook.

We have used the Products Table of Northwind.accdb sample database for grouping of records on Product Category. 

The Export2ExcelB() Function VBA Code:

Public Function Export2ExcelB(ByVal xlFileLoc As String, ByVal QryORtableName As String) As String
'----------------------------------------------------------------
'Creates separate Excel WorkBook for each Group of Records
'based on changing Query criteria.
'Uses Query Name Used for workBook Name
'----------------------------------------------------------------
On Error GoTo Export2ExcelB_Err
Dim strSQL As String
Dim m_min As Integer, m_max As Integer
Dim j As Integer
Dim qryName As String
Dim qryDef As QueryDef
Dim db As Database, rst As Recordset

Dim xlsPath As String
Dim xlsName As String
Dim wrkBook As Excel.Workbook

m_min = CInt(DMin("seq", "QryParam"))
m_max = CInt(DMax("seq", "QryParam"))

    xlsName = QryORtableName & ".xlsx"
    xlsPath = xlFileLoc & xlsName
    
If Len(Dir(xlsPath)) > 0 Then
    Kill xlsPath
End If

    Set wrkBook = Excel.Workbooks.Add
    wrkBook.SaveAs xlsPath
    wrkBook.Close
        
Set db = CurrentDb
For j = m_min To m_max

strSQL = "SELECT Products.[Product Code], QryParam.Category, " & _
"Mid([Product Name],19) AS ProductName, Products.[Standard Cost], " & _
"Products.[List Price], Products.[Quantity Per Unit] " & _
"FROM QryParam INNER JOIN Products ON QryParam.Category = Products.Category " & _
"WHERE (((QryParam.Seq)= " & j & "));"

qryName = "Category_" & Format(j, "000")
On Error Resume Next
Set qryDef = db.CreateQueryDef(qryName)
If Err Then
   Err.Clear
   Set qryDef = db.QueryDefs(qryName)
End If
On Error GoTo 0
    qryDef.SQL = strSQL
    db.QueryDefs.Refresh
    
    DoCmd.TransferSpreadSheet acExport, acSpreadsheetTypeExcel12Xml, qryName, xlsPath, True
   
    db.QueryDefs.Delete qryName
Next
    MsgBox m_max & " Excel WorkSheets Created " & vbCr & "in Folder: " & xlsPath, , "Export2ExcelB()"
    Set wrkBook = Nothing
    Export2ExcelB = xlsPath
    
Export2ExcelB_Exit:
Exit Function

Export2ExcelB_Err:
MsgBox Err & " : " & Err.Description, , "Export2ExcelB()"
Export2ExcelB = ""
Resume Export2ExcelB_Exit
End Function

The above Code creates a WorkBook and saves the file in the specified target location and then closes the WorkBook.

We have put the WorkBook creation code above the For . . . Next Loop and creates only a single workbook and saves all the Output workSheets created for Products Group in the same WorkBook. 

All Output Worksheets in Different WorkBook.

In this case, we will shift the Excel Workbook creation Code Segment within the For . . . Next Loop. It creates a different WorkBook, for each output WorkSheet for products group, and passes the WorkBook reference in the  Transfer Spreadsheet Command. All Worksheets will be saved in a separate Excel Workbook in the next Function.

The Export2ExcelC() Function VBA Code:

Public Function Export2ExcelC(ByVal xlFileLoc As String) As String
'----------------------------------------------------------------
'Creates separate Excel WorkBook for each Group of Records
'based on changing Query criteria.
'Uses Query Name Used for workBook Name
'----------------------------------------------------------------
On Error GoTo Export2ExcelC_Err
Dim strSQL As String
Dim m_min As Integer, m_max As Integer
Dim j As Integer
Dim qryName As String
Dim qryDef As QueryDef
Dim db As Database, rst As Recordset

Dim xlsPath As String
Dim xlsName As String
Dim wrkBook As Excel.Workbook

m_min = CInt(DMin("seq", "QryParam"))
m_max = CInt(DMax("seq", "QryParam"))

Set db = CurrentDb
For j = m_min To m_max

strSQL = "SELECT Products.[Product Code], QryParam.Category, " & _
"Mid([Product Name],19) AS ProductName, Products.[Standard Cost], " & _
"Products.[List Price], Products.[Quantity Per Unit] " & _
"FROM QryParam INNER JOIN Products ON QryParam.Category = Products.Category " & _
"WHERE (((QryParam.Seq)= " & j & "));"

qryName = "Category_" & Format(j, "000")
On Error Resume Next
Set qryDef = db.CreateQueryDef(qryName)
If Err Then
   Err.Clear
   Set qryDef = db.QueryDefs(qryName)
End If
On Error GoTo 0
    qryDef.SQL = strSQL
    db.QueryDefs.Refresh

        xlsName = qryName & ".xlsx"
        xlsPath = xlFileLoc & xlsName
        Set wrkBook = Excel.Workbooks.Add
        wrkBook.SaveAs xlsPath
        wrkBook.Close
    
    DoCmd.TransferSpreadSheet acExport, acSpreadsheetTypeExcel12Xml, qryName, xlsPath, True
   
    db.QueryDefs.Delete qryName
Next
    MsgBox m_max & " Excel Files Created " & vbCr & "in Folder: " & xlFileLoc, , "CreateXLSheets()"
    Set wrkBook = Nothing
    Export2ExcelC = xlFileLoc & qryName & ".xlsx"

Export2ExcelC_Exit:
Exit Function

Export2ExcelC_Err:
MsgBox Err & " : " & Err.Description, , "Export2ExcelC()"
Export2ExcelC = ""
Resume Export2ExcelC_Exit
End Function

A Demo Database with all the three Function Code with sample Data of Products table and Queries is attached for Download.


  1. Running-Sum in MS-Access Query
  2. Opening Access Objects from Desktop
  3. Diminishing Balance Calc in Query
  4. Auto Numbers in Query Column Version-2
  5. Word Mail-Merge With Ms-Access Table
Share:

MS-Access and Creating Desktop Shortcuts.

Introduction.

The CreateShortcut() method of the Windows Script Object can be used for creating Desktop Shortcuts in Microsoft Access.  The Desktop Shortcut can launch frequently used Files like MS-Access, MS-Excel, MS-Word,  Text Document, and others from the Desktop. This fact is known to all of us and nothing new.  But, how do we do it from Access?

We have used the Popup() method of the Windows Script Object earlier for another Project.  We have created a new Message Box in Microsoft Access that closes itself after a specified time.  The Access MsgBox always requires the user to click on one of the displayed Buttons to close and continue with the Code execution.  Hope you have already tried it out and started using it in your Projects.

The VBA ShortCut() Function Prototype.

The simple VBA Function Code that creates a Desktop Shortcut is given below for a quick look at it. All the required parameters are given as constants in the Function for clarity.

Public Function ShortCut()
Dim objwshShell As Object
Dim objShortcut As Object

Set objwshShell = VBA.CreateObject("WScript.Shell")
Set objShortcut = objwshShell.CreateShortCut("C:\Users\User\Desktop\Hello.txt.lnk")
With objShortcut
    .TargetPath = "C:\Windows\Notepad.exe "
    .Arguments = "D:\Docs\Hello.txt"
    .WorkingDirectory = "D:\Docs"
    .Description = "Opens Hello.txt in Notepad"
    .HotKey = "Ctrl+Alt+9"
    .IconLocation = "C:\Windows\System32\Shell32.dll,130"
    .WindowStyle = 2
    .Save
End With
End Function

You can create a Desktop Shortcut with the above VBA Code with few changes on the highlighted portion of the Parameter Values.

  1. Replace the User with your own Windows User-Name.
  2. Create a Text File with some text in it and name the file as Hello.txt. 
  3. Save the File in one of your Folders. 
  4. Change the File Path Name correctly in the. Arguments Value shown highlighted.
  5. Change the Working Directory of your File in the next line.
  6. The rest of the Values can remain as they are.

The HotKey Ctrl+Alt+9 Keys Combination launches the Desktop Shortcut and opens the File for editing.

The Desktop Shortcut Icon.

In the IconLocation Parameter, check the number 130 at the end and it gives the required Desktop Icon.  This Numeric Value Range is from 0 to 305 and gives different Icons for your Desktop Shortcut.

The Number 130 gives the following Icon Image:

You can change the Shortcut Icon manually too.

  1. Right-Click on a Desktop Shortcut Icon and select the Properties from the displayed list.
  2. Click on the Change Icon Command Button on the Shortcut Tab.
  3. Select the required Icon, click OK to close the Icon List.
  4. Click Apply Command Button to update the change.

Icon Images List.

It displays the Icon Images of about 76 columns of 4 Images each.  To find a particular Icon’s number start counting from the left top items to the right and multiply the count by 4 and find the Icon’s Number.  I could not find any other way to find the Icon Image number easier than the above method. Check the Image given below:

The DesktopShortcut() Function.

Now, we are ready for our VBA Function that can accept the minimum three required Parameters, which can be passed to the Function at Call time, and Create a Desktop Shortcut.  The VBA Code is given below.

Option Compare Database
Option Explicit


Public Function DesktopShortCut(ByVal strShortCutName As String, _
ByVal strProgramPath As String, _
ByVal strFilePath As String, _
Optional strWorkDirectory As String = "", _
Optional ByVal strHotKey As String = "") As Boolean

On Error GoTo DesktopShortCut_Err
'-----------------------------------------------------------------
'Function: DesktopShortCut()
'Author: a.p.r. pillai
'Rights: All Rights(c) Reserved by www.msaccesstips.com
'Remarks: You may modify the Code, but need to keep these
'Rem lines intact.
'Parameters
'-----------------------------------------------------------------
'1. Shortcut Name: Shows below the Desktop Icon
'2. strProgramPath: e.g.: "C:\Windows\System32\Notepad.exe"
'3. strfilePath: File PathName to Open, e.g. "D:\Docs\Helloworld.txt"
'4. Optional strWorkDirectory: e.g. "D:\Docs"
'5. Optional strHotKey: Quick Launch - e.g. Ctl+Alt+9: 1-9,A-Z
'-----------------------------------------------------------------
Dim objwshShell As Object
Dim objShortcut As Object
Dim strPath As String
Dim strProg As String, a As String, b As String
Dim strTemp As String
Dim DeskPath As String
Dim strmsg As String
Dim badchar As String, Flag As Boolean
Dim j, count As Integer

strPath = Environ("Path")

'Validation Checks
GoSub IsValidName
GoSub ValidateParams

'Find Current User Desktop
strTemp = Mid(strPath, InStr(1, strPath, "C:\Users\"), 25)
DeskPath = "C:\Users\" & Mid(strTemp, 10, InStr(10, strTemp, "\") - 10) & "\Desktop\"
DeskPath = DeskPath & strShortCutName & ".Lnk"

Set objwshShell = VBA.CreateObject("WScript.Shell")
Set objShortcut = objwshShell.CreateShortCut(DeskPath)
With objShortcut
If InStr(1, Trim(strProgramPath), " ") > 0 Then
    .TargetPath = Chr(34) & Trim(strProgramPath) & Chr(34) '="C:\Windows\Notepad.exe"
Else
    .TargetPath = Trim(strProgramPath)
End If
If InStr(1, Trim(strFilePath), " ") > 0 Then
    .Arguments = Chr(32) & Chr(34) & strFilePath & Chr(34) '="D:\Docs\Hello.txt"
Else
    .Arguments = Chr(32) & strFilePath '="D:\Docs\Hello.txt"
End If
'Optional Working Directory
 If Len(strWorkDirectory) > 0 Then
    .WorkingDirectory = strWorkDirectory '="D:\Docs"
 End If
 'Optional Keyboard HotKey
 If Len(Nz(strHotKey, "")) > 0 Then
    .HotKey = "Ctrl+Alt+" & strHotKey '= "Ctrl+Alt+K"
 Else
    .HotKey = ""
 End If
    .IconLocation = "C:\Windows\System32\Shell32.dll,130" '0 - 305
    .WindowStyle = 2
    .Save
End With
DesktopShortCut = True

DesktopShortCut_Exit:
Exit Function

IsValidName:
Flag = True
badchar = "\/:*?" & Chr(34) & "<>|"
count = 0
For j = 1 To Len(strShortCutName)
    If InStr(1, badchar, Mid(strShortCutName, j, 1)) Then
        count = count + 1
    End If
Next
Flag = IIf(count, False, True)
If Not Flag Then
    MsgBox "Shortcut Name: " & strShortCutName & vbCr & vbCr _
    & "Contains Invalid Characters." & vbCr & vbCr _
    & "*** Program Aborted. ***", , "DeskShortCut()"
    
    DesktopShortCut = False
    Exit Function
End If
Return

ValidateParams:
strmsg = ""
'Program Path
If Len(Nz(strProgramPath, "")) > 0 Then
   'Check whether the Program exists in the given path
   If InStr(1, strProgramPath, Dir(strProgramPath)) = 0 Then
     strmsg = "Program Path: " & strProgramPath & " Invalid."
   End If
Else
   strmsg = "Program Path: Not found!"
End If
'File Path
If Len(Nz(strFilePath, "")) > 0 Then
   If InStr(1, strFilePath, Dir(strFilePath)) = 0 Then
     If Len(strmsg) > 0 Then
        strmsg = strmsg & vbCr & "File Path: " & strFilePath & " Invalid."
     Else
        strmsg = "File Path: " & strFilePath & " Invalid."
     End If
   End If
Else
    If Len(strmsg) > 0 Then
        strmsg = strmsg & vbCr & "File Path: Not found!"
    Else
        strmsg = "File Path: Not found!"
    End If
End If
If Len(strmsg) > 0 Then
    MsgBox strmsg, , "DeskShortCut()"
    DesktopShortCut = False
    Exit Function
End If
Return

DesktopShortCut_Err:
MsgBox Err & " : " & Err.Description, , "DesktopShortCut()"
DesktopShortCut = False
Resume DesktopShortCut_Exit
End Function

The DesktopShortcut() Function is defined with five Parameters and the last two are Optional.  The Working Directory and HotKey Parameter Values are optional.

We have added Validation checks on the passed parameter values and Error Trapp Lines to avoid crashes due to unexpected Errors and to exit from the Function gracefully.

Sample Run of DesktopShortcut() Function.

The sample Run of the Function from the Immediate Window is given below:

Sample Run-1.

DesktopShortcut "HelloMyDB","C:\Program Files (x86)\Microsoft Office\Office12\MSACCESS.EXE","D:\New Folder\ClassDB.accdb"

Sample Run-2.

DesktopShortcut "HelloMyDoc","C:\Program Files (x86)\Microsoft Office\Office12\WINWORD.EXE","D:\Docs\TelNo2411808.docx","D:\Docs","T"


The TreeView Control Tutorial Session Links.

  1. Microsoft TreeView Control Tutorial
  2. Creating Access Menu with TreeView Control
  3. Assigning Images to TreeView Control
  4. Assigning Images to TreeView Control-2
  5. TreeView Control Check-Mark Add Delete Nodes
  6. TreeView ImageCombo Drop-Down Access Menu
  7. Re-arrange TreeView Nodes by Drag and Drop
  8. ListView Control with MS-Access TreeView
  9. ListView Control Drag Drop Events
  10. TreeView Control With Subforms
Share:

Message Box that Closes itself after Specified Time

Introduction.

The new Message Box in Microsoft Access is an interesting one, which was in all of our minds, I would say, for a long time.  A Message Box that closes itself, after displaying some useful information and that doesn’t need any response from the User to resume Code execution.  Now, we could do that. We will create a new  Message Box that disappears itself after completion of the specified time.

It can be used as a progress meter within a process, if it takes a long time to complete.  It can display useful information about the progress of the process, at intervals of certain fixed cycles of the process to the impatient User.  

This Message Box is based on the Popup() Method of the Windows Scripting Object.

This message box accepts all the parameters of the Access MsgBox function, except [helpfile] and [context] parameters.  In addition to that it has another optional parameter, the time value in seconds. The time value in seconds determines how long this message box stays visible on the screen.  When the time completes the message box disappears, it will not wait for you to click on a button to dismiss it.  If you click on one of the displayed buttons, it closes immediately and will not wait to complete the specified time.  So it works in both ways, if you omit the time parameter the message box will wait for a click from the user.

Assume that the time parameter value specified is 5 seconds, It will disappear automatically after 5 seconds.  This is good for displaying useful information to the user if some process or program takes too long to complete, or what process is going to execute next, and so on, to keep the user informed.

MesgBox() is the New Name.

We have given a suitable name MesgBox() to our new Message Box functionThe letter e is inserted between the letter M and s of our Access MsgBox function name.  I think it is easier to remember while writing Code.

The Access MsgBox parameters msgText, buttons, Title are all valid for the new MesgBox function.  Buttons like vbOkOnly, vbOkCancel, and others.  The Icons vbCritical, vbInformation, and others.  To specify the selected default button like in vbOkCancel+vbCritical+vbDefaultButton2.  In the new MesgBox function there is one more parameter the time value in Seconds, to specify how long the message box should remain on Screen before disappearing, expressed in Integer Seconds.

The sample image of the new MesgBox() with n seconds duration is given below:

Exactly after n seconds, it will close itself.  The time value is not displayed on the message box.

Even if you omit the Optional button parameter the Ok button will appear by default.

Note: If you think that it is necessary that the User should know the duration of the message on the screen then concatenate the time value as part of the message.

If you click on one of the displayed Buttons before the full-delay time it will close immediately and will not wait for completing the specified time value as the parameter.  The time value parameter is optional if omitted or is zero value then it behaves like Access MsgBox.  The user should click on one of the displayed buttons to dismiss it.

Access MsgBox() and New MesgBox() Functions.

The new MesgBox() Function needs only a bare minimum of three lines of Code.  Before taking up the complete function Code let us compare Access MsgBox() and new MesgBox() Function Syntax.

1.  Access MsgBox stays on screen and the Code execution stops till the user clicks on one of the displayed Buttons.

NB: If you are on a Mobile device then to view the full length of the Code line touch on the Code Window and slide to the left.

‘Syntax: opt = MsgBox(msgTxt,[Buttons]+[Icon]+[DefaultButton],[Title])

opt = MsgBox("Preparing Report, Please Wait. . .",vbOkCancel+vbInformation+vbDefaultButton2,"Reports")

2.  The new MesgBox closes itself and the Code execution continues after the time specified in seconds as one of its parameters or immediately after the user clicks on one of the displayed buttons, whichever happens first. The delay time expressed in Integer Seconds and is passed as the second parameter to the Function.

‘Syntax: opt = MesgBox(msgTxt,[intSeconds],[Buttons]+[Icon]+[DefaultButton],[Title])

opt = MesgBox(“Preparing Report, Please Wait. . .”,5,vbOkCancel+vbInformation+vbDefaultButton2,”Reports”)

In the new MesgBox Function, the delay time value in seconds is the second parameter after the msgText parameter, the Buttons+Icon+defaultbutton is the third and the Title comes last.  Like the Access message box, all parameters are optional except the first one.

When the above MesgBox function call executes this message box appears with the Cancel Button already selected by default.  If the selected button option is acceptable to the user he can press Enter Key immediately to dismiss the message box or Click on his preferred choice of option.  If not then after 5 seconds the message box will close itself. 

Omitting Time Param works like Access MsgBox().

If selecting an option is mandatory then omit the Time Value parameter, or enter 0 (zero) value for the time parameter to keep the MesgBox on Screen till the User selects one of the displayed Option Buttons.

Note: Our new MesgBox Function is based on Microsoft Windows Script Host’s Popup() Method and accepts all the Access MsgBox Function Parameter Values  (except HelpFile and Context parameters) in a different order. Check the Syntax of Popup() Method given below:

'Syntax:

expression = winShell.Popup(strText, [intSeconds], [strTitle], [intButtons])

Since we have derived our new MesgBox Function from Windows Script Host Object’s Popup() method we have organized the order of parameters for our function in almost the same order as the Access MsgBox() function. But, they will be passed to the Popup() function in the required order.

MesgBox Function VBA Code.

Here is the VBA Code of the new MesgBox() Function.  It takes only three lines of code.

Public Function MesgBox(ByVal msgText As String, _
    Optional ByVal intSeconds As Integer, _
    Optional ByVal intButtons = vbDefaultButton1, _
    Optional TitleText As String = "WScript") As Integer

Dim winShell As Object

Set winShell = CreateObject("WScript.Shell")

MesgBox = winShell.PopUp(msgText, intSeconds, TitleText, intButtons)

End Function

If the user clicks on one of the displayed buttons its corresponding Integer value is returned to the Calling Program.

You may call the MesgBox() function from the Immediate Window (Debug Window) with a different set of Optional Parameters and test it yourself in various ways to familiarize its usage.

The MesgBox() Function Demo Test Subroutine.

We have a demo program to test the new MesgBox() function with different sets of Buttons, Icons, and time values.  When the user clicks on a Button or allowed to close itself then the program checks the returned value and displays a second MesgBox with an appropriate response and disappears after 3 seconds.

Public Sub MesgBox_example()
Dim opt As Integer
Dim Title As String
Dim intSeconds As Integer
Dim optSeconds As Integer
Dim Tip1 As String

Title = "MesgBox_example"
intSeconds = 5
optSeconds = 3
Tip1 = "Click Button before time ends in " & intSeconds & " Seconds" & vbCr & vbCr

'//Enable only one of the four methods given below.

opt = MesgBox("Preparing Monthly Report" & vbCr & "Please wait . . .", intSeconds, vbInformation, "Info")

'opt = MesgBox(Tip1 & "Preparing Monthly Report" & vbCr & "Please wait . . .", intSeconds, vbInformation + vbOKCancel, "Info")

'opt = MesgBox("Cannot Delete Records . . .!", , vbExclamation + vbAbortRetryIgnore + vbDefaultButton3, "Delete")
    
'opt = MesgBox("Database Shutdown . . .?", , vbCritical + vbYesNo + vbDefaultButton2, "Shutdown")

'// Test whether the button clicked or not, if it did then which button/returned value.
Select Case opt
    Case -1 ' No button selected, MesgBox closed automatically after the time specified.
    
        '//In this MesgBox the time parameter is omitted, works like Access MsgBox. Need to click the Button to close.
        MesgBox "No Button Selected." & vbCr & "Click Ok button here to close this MesgBox.", , vbInformation, Title
    
'//The following options work only when the MesgBox button receives the Click.
    Case vbOK '- 1
        MesgBox "Preparing Report" & vbCr & "User's Response Ok", optSeconds, vbInformation, Title
    
    Case vbCancel '- 2
        MesgBox "Not to Prepare Report" & vbCr & "User's Response Cancel", optSeconds, vbInformation, Title
    
    Case vbAbort '- 3
        MesgBox "Record Deletion Aborted.", optSeconds, vbExclamation, Title
    
    Case vbRetry '- 4
        MesgBox "Retrying Record Deletion.", optSeconds, vbExclamation, Title
    
    Case vbIgnore '- 5
        MesgBox "Record Deletion Process Ignored.", optSeconds, vbExclamation, Title
    
    Case vbYes '-  6
        MesgBox "Yes, Shutdown Approved.", optSeconds, vbCritical, Title
        'DoCmd.CloseDatabase
    Case vbNo '- 7
        MesgBox "Database Shutdown Denied.", optSeconds, vbCritical, Title
End Select


End Sub

Save the Code in Access Global Module.

Copy the MesgBox() and the MesgBox_Example() VBA Code into a Global Module and save the Code.  Compile the Code to ensure that everything is in order.

In the MesgBox_example() the first MesgBox() Function Calling line is already enabled.  You may click somewhere within the Code and press the F5 Key to Run the Code.  It will display the message box with the Ok Button alone and after five seconds the MesgBox will close itself.  The returned value is –1 in Opt Variable.

The returned value is tested in the next section and displays an appropriate message.  In this particular message line under the Case –1 testthe time value parameter is omitted and the message box behaves like the Access MsgBox.  When the time parameter value is omitted or zero (0) then you must click on a button on the message box to close it. 

Run the same option a second time and this time click on the Ok button before the message box closes. The Clicked button-value is returned to the Opt Variable.  The Ok button-click returns the value 1.  Based on the returned value it displays an appropriate message and closes it after 3 seconds.

Disable the tried-out line by inserting the comment symbol at the beginning and enable the next line by removing the comment symbol.  Test the enabled line with different buttons, Icons by repeating the above method.

A Critical Message Box:

The MesgBox() function is called directly from the Debug Window (Immediate Window) with the function parameters as given below:

msgTxt = "Database Shutdown . . .?"

MesgBox msgTxt,,vbYesNo+vbCritical+vbDefaultButton2,"Shutdown"

Points to Note.

  1. Take Note of these Side effects:

    Since it is Windows Script-based control, even if you minimize the Access Application Window the MesgBox will appear on the Windows Desktop.

  2. If the Time Value parameter is omitted then the user needs to click on a Button, like Access MsgBox to dismiss the MesgBox Control. In between if the user clicks somewhere other than the MesgBox control, it will disappear and goes behind the Access Application Window, and stays on the Windows Desktop.

  3. Our VBA Program is still in executing state and waiting for the response of the User on the MesgBox Control. At this time if you try to close the Database it will ignore the attempt and will not provide any clue.  But, you may use the Exit Access Option from Office Button to Shutdown Access Application altogether.

We are familiar with Microsoft Windows Common Controls, like TreeView, ListView, ImageList, and others.  The above function works with Windows Script Object’s Popup() method.  Unlike Windows Common Control (the MSCOMCTL.OCX) you don’t need to attach the Windows Script Host Object Model (C:\Windows\SysWOW64\wshom.ocx file) to the Reference Library List.

If you are facing any issues in using this Windows feature please visit the Microsoft Support Page for suggestions to correct your issue.

Here is the Code of MesgBox() Function with Error-trap lines inserted.

Public Function MesgBox(ByVal msgText As String, _
    Optional ByVal TimeInSeconds As Integer, _
    Optional ByVal intButtons = vbDefaultButton1, _
    Optional TitleText As String = "WScript") As Integer

On Error GoTo MesgBox_Err
Dim winShell As Object

Set winShell = CreateObject("WScript.Shell")

MesgBox = winShell.PopUp(msgText, TimeInSeconds, TitleText, intButtons)

MesgBox_Exit:
Exit Function

MesgBox_Err:
winShell.PopUp Err & " : " & Err.Description, 0, "MesgBox()", vbCritical
Resume MesgBox_Exit
End Function

Since you understood the advantages and disadvantages of both the functions MsgBox and MesgBox use them sparingly.  If you share your Application with the new MesgBox() Function then ensure that it works in the new location.

The TreeView Control Tutorial Session Links.

  1. Microsoft TreeView Control Tutorial
  2. Creating Access Menu with TreeView Control
  3. Assigning Images to TreeView Control
  4. Assigning Images to TreeView Control-2
  5. TreeView Control Check-Mark Add Delete Nodes
  6. TreeView ImageCombo Drop-Down Access Menu
  7. Re-arrange TreeView Nodes by Drag and Drop
  8. ListView Control with MS-Access TreeView
  9. ListView Control Drag Drop Events
  10. TreeView Control With Subforms
Share:

TreeView Control with Subforms

Introduction.

In this Session of the TreeView Control Tutorial, we will use two Subforms along with the TreeView control on the main form frmTreeViewtab.  We have imported the ImageList control with the preloaded Images from our earlier demo Project. 
We will use the same lvCategory and lvProducts Tables we have used for our earlier Projects. 
The lvCategory Table's Primary Key field (CID) and Description field (Category) values are the TreeView Nodes Add() method's Key and Text parameter values, respectively.

The lvProducts Table has detailed information on each product like product code, description stock-unit-quantity, and list price. 

Besides that, the lvProducts table has the ParentID field that updated with the Category code (CID)  value.  All the product items that belong to a particular category are updated with the (Category ID) CID field value on the ParentID field. This way both the Tables have the master-child relationship.

The Product records have two subforms on the Tab Control Pages.  The first Page has the data View subform and the second Page has the Edit subform. The first tab control Page displays all the Product records that belong to a particular category of the TreeView Control.  The first subform records are displayed for viewing and for selecting a particular record for editing on the second subform.

The current record or user-selected record on the first sub-form is available for editing on the second sub-form, on the second page of the Tab control. The Key fields highlighted with grey color are locked and cannot be edited.

TreeView with Subforms Design View.

The Design View of the form frmTreeViewTab is given below:

The first two unbound text boxes on the main form are updated when the user selects a Category item from the TreeView control.  

The third unbound textbox (name p_ID) is initially updated with the first product record’s unique ID (PID) value otherwise the user-selected record’s value gets updated.  The selected product record on the first subform is available on the second subform for modifications.

Links to Earlier Tutorial Sessions.

The earlier Tutorial Session Links are given below for ready reference:

  1. Microsoft TreeView Control Tutorial
  2. Creating Access Menu with TreeView Control
  3. Assigning Images to TreeView Control
  4. Assigning Images to TreeView Control-2
  5. TreeView Control Check-Mark Add Delete Nodes
  6. TreeView ImageCombo Drop-Down Access Menu
  7. Re-arrange TreeView Nodes by Drag and Drop
  8. ListView Control with MS-Access TreeView
  9. ListView Control Drag Drop Events

 The CatId unbound textbox is the [Link Master Fields] Property value of the first subform.

The Product Code on the third unbound textbox (p_ID) is linked to the [Link Master Fields] property value of the second subform on the View Tab Page. 

The p_ID unbound textbox value gets updated when the first subform contents refreshed or when an item selected by the user.

Normal View of the Screen.

The normal view of the frmTreeViewTab form is given below:


The Key fields on the Product record on the second subform,  with grey forecolor, are locked and not allowed to modify contents.

The form frmTreeViewTab Class Module VBA Code:

Option Compare Database
Option Explicit

Dim tv As MSComctlLib.TreeView
Dim imgList As MSComctlLib.ImageList
Const Prfx As String = "X"

Private Sub Form_Load()
Dim db As DAO.Database
Dim tbldef As TableDef

'Initialize TreeView Nodes
    Set tv = Me.TreeView0.Object
    tv.Nodes.Clear
'Initialixe ImageList Object
    Set imgList = Me.ImageList3.Object
    
'Modify TreeView Font Properties
With tv
    .Font.Size = 9
    .Font.Name = "Verdana"
    .ImageList = imgList 'assign preloaded imagelist control
 End With
    
   LoadTreeView 'Create TreeView Nodes

End Sub

Private Sub LoadTreeView()
    Dim Nod As MSComctlLib.Node
    Dim strCategory As String
    Dim strCatKey As String
    Dim strProduct As String
    Dim strPKey As String
    Dim strBelongsTo As String
    Dim strSQL As String
    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    
    'Initialize treeview nodes
     tv.Nodes.Clear
    
    strSQL = "SELECT lvCategory.CID, lvCategory.Category, "
    strSQL = strSQL & "lvcategory.BelongsTo FROM lvCategory ORDER BY lvCategory.CID;"
    
    Set db = CurrentDb
    Set rst = db.OpenRecordset(strSQL, dbOpenSnapshot)

    ' Populate all Records as Rootlevel Nodes
    Do While Not rst.BOF And Not rst.EOF
        If rst.AbsolutePosition = 1 Then
           Me![CatID] = rst![CID]
        End If
            strCatKey = Prfx & CStr(rst!CID)
            strCategory = rst!Category
            
            Set Nod = tv.Nodes.Add(, , strCatKey, strCategory, 1, 2)
            Nod.Tag = rst!CID
        rst.MoveNext
    Loop
    
    'In the second pass of the the same set of records
    'Move Child Nodes under their Parent Nodes
    rst.MoveFirst
    Do While Not rst.BOF And Not rst.EOF
        strBelongsTo = Nz(rst!BelongsTo, "")
        If Len(strBelongsTo) > 0 Then
            strCatKey = Prfx & CStr(rst!CID)
            strBelongsTo = Prfx & strBelongsTo
            strCategory = rst!Category
            
            Set tv.Nodes.Item(strCatKey).Parent = tv.Nodes.Item(strBelongsTo)
        End If
        rst.MoveNext
    Loop
    rst.Close
    

    TreeView0_NodeClick tv.Nodes.Item(1)
    
End Sub

Private Sub TreeView0_NodeClick(ByVal Node As Object)
Dim Cat_ID As String

'Initialize hidden unbound textbox 'Link Master Field' values
Cat_ID = Node.Tag
Me!CatID = Cat_ID
Me![xCategory] = Node.Text

End Sub

Private Sub cmdExit_Click()
    DoCmd.Close
End Sub


Since TreeView Control and ImageList Control usage and their functioning were all explained in detail in the earlier sessions, you will find only a few of those earlier VBA subroutines appear in the above form Module.

We have designed several Screens with MS-Access TreeView, ListView, ImageList, and ImageCombo Control so far and I hope you will find them as a good reference point for your own Project Interface design.

MS-Office Version Issues for TreeView Control.

If you had any issues in running the Demo Database in your version of Microsoft Access then you may refer to the following link for some corrective actions, which may be helpful to solve your issue:

Earlier, the above Controls were not running under 64 Bit Systems. But, in September 2017 Microsoft has brought out an update of MSCOMCTL.OCX Library and the following extract of the Microsoft Document is given below for your information:

Click on the above Document image for the full text of the 2017 Update:1707 Document.  The following link suggests some helpful hints.

With the use of the above TreeView control objects, we can build better-looking and better performing User-Interfaces for our new Projects. 

Download the Demo Database.


Share:

ListView Control Drag Drop Events Handling

Introduction.

We are familiar with the Drag and Drop operations on TreeView Control, in Ms-Access that rearranges Nodes.  All the base records for the Treeview Control Nodes come from a single Access Table.  We always update the Source Node’s ParentID field value, with the Target Node’s ID Value on the same Table record, to make the change of position on the TreeView Control.  The records are not moved physically anywhere.

Here, with the addition of ListView Control along with TreeView Control, we plan to work with two different Access Tables.

  1. lvCategory – Category Code and Description.
  2. lvProducts – Categorywise Products.

This way it is easier to understand the relationship between both Tables.  What changes we have to make and where, when one Product Item (ListView item) moves from one Category to the other on the TreeView Control. 

The lvCategory Access Table has 20 records for the TreeView Nodes and the lvProducts Table has 45  for the ListView Control.  One or more records in the Products table are directly related to a product category on the Category Table.  The relationship between them has been updated with the Category ID (CID) Field value on the Product Table’s ParentID field so that the change of category of the product reflects immediately on the ListView Control. 

The demo data table was taken from Microsoft Access Sample Database Northwind.accdb and split into two parts.

Based on the ParentID Field Value, of lvProduct records, we could filter and list all the related product items in the ListView Control, when a Category Node gets selected on the TreeView Control.

Topics we have Covered So Far.

The following are the main Topics on TreeView, ImageList, ImageCombo, and ListView Controls, we have covered so far in MS-Access:

  1. Microsoft TreeView Control Tutorial
  2. Creating Access Menu with TreeView Control
  3. Assigning Images to TreeView Control
  4. Assigning Images to TreeView Control-2
  5. TreeView Control Check-Mark Add Delete Nodes
  6. TreeView ImageCombo Drop-Down Access Menu
  7. Re-arrange TreeView Nodes by Drag and Drop
  8. ListView Control with MS-Access TreeView

The ListView Drag-Drop Task.

As far as ListView’s Drag and Drop operation is concerned, it is a simple exercise comparing the same method within the TreeView Control alone.  Since the Drag Drop action involves both TreeView and ListView Controls, we use the same TreeView0_OLEDragDrop() Event Procedure with some simple VBA Code.

The Product items listed in the ListView Control belong to the current Category item selected in the TreeView Control.

The User selects a particular product item from the ListView Control, if he/she thinks that it belongs to a different Category Item,  then drag and drop it on the target Category item on the TreeViewCcontrol. 

The moved ListView Product Item will be added to the list of items that belong to the changed Category. The product record’s ParentID field value gets updated with the target Category record ID (CID value). 

It is only a one-way action, always move the ListView item from one category and drop it on a different Category Node on the TreeView Control. 

The ListView drag-drop demo Access Form frmListViewDrag’s trial run Screen image is given below:

In the above Image, the Beverages Category on the TreeView has been selected.  The products belong to the Beverages category have been listed in the ListView Control.

The Design View of the above Form:

The List of Control names on the Form are as given below:

  1. TreeView Control: TreeView0
  2. ListView Control: ListView0
  3. ImageList Control: ImageList3
  4. Command Button: cmdClose

The VBA Code on the frmListViewDrag’s Class Module:

Option Compare Database
Option Explicit

Dim tv As MSComctlLib.TreeView
Dim lvList As MSComctlLib.ListView
Dim imgList As MSComctlLib.ImageList
Const Prfx As String = "X"

Private Sub Form_Load()
Dim db As DAO.Database
Dim tbldef As TableDef

    Set tv = Me.TreeView0.Object
    tv.Nodes.Clear
    
    Set imgList = Me.ImageList3.Object
    
With tv
    .Font.Size = 9
    .Font.Name = "Verdana"
    .ImageList = imgList 'assign preloaded imagelist control
 End With
    
    Set lvList = Me.ListView0.Object
    lvList.ColumnHeaders.Clear
    lvList.ListItems.Clear
    lvList.Icons = imgList
    
    Set db = CurrentDb
    Set tbldef = db.TableDefs("lvProducts")
    
    'Initialize ListView & Column Headers Property Values
     With lvList
        .ColumnHeaderIcons = imgList
        .Font.Size = 9
        .Font.Name = "Verdana"
        .Font.Bold = False
        
        'ColumnHeaders.Add() Syntax:
        'lvList.ColumnHeaders.Add Index, Key, Text, Width, Alignment, Icon
        'Alignment: 0 - Left, 1 - Right, 2 - Center
        .ColumnHeaders.Add 1, , tbldef.Fields(1).Name, 2600, 0, 5
        .ColumnHeaders.Add 2, , tbldef.Fields(3).Name, 2600, 0, 5
        .ColumnHeaders.Add 3, , tbldef.Fields(4).Name, 1440, 1, 5
    End With
    
    Set db = Nothing
    Set tbldef = Nothing

    
   LoadTreeView 'Create TreeView Nodes

End Sub

Private Sub LoadTreeView()
    Dim Nod As MSComctlLib.Node
    Dim firstCatID As Long
    Dim strCategory As String
    Dim strCatKey As String
    Dim strBelongsTo As String
    Dim strSQL As String
    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    
    'Initialize treeview nodes
     tv.Nodes.Clear
     
    'Initialize Listview nodes
    While lvList.ListItems.Count > 0
          lvList.ListItems.Remove (1)
    Wend
    
    strSQL = "SELECT lvCategory.CID, lvCategory.Category, "
    strSQL = strSQL & "lvcategory.BelongsTo FROM lvCategory ORDER BY lvCategory.CID;"
    
    Set db = CurrentDb
    Set rst = db.OpenRecordset(strSQL, dbOpenSnapshot)
    
    If Not rst.BOF And Not rst.EOF Then
        rst.MoveFirst
        firstCatID = rst!CID
    Else
        Exit Sub
    End If
    ' Populate all Records as Rootlevel Nodes
    Do While Not rst.BOF And Not rst.EOF
            strCatKey = Prfx & CStr(rst!CID)
            strCategory = rst!Category
            
            Set Nod = tv.Nodes.Add(, , strCatKey, strCategory, 1, 2)
            Nod.Tag = rst!CID
        rst.MoveNext
    Loop
    
    'In the second pass of the the same set of records
    'Move Child Nodes under their Parent Nodes
    rst.MoveFirst
    Do While Not rst.BOF And Not rst.EOF
        strBelongsTo = Nz(rst!BelongsTo, "")
        If Len(strBelongsTo) > 0 Then
            strCatKey = Prfx & CStr(rst!CID)
            strBelongsTo = Prfx & strBelongsTo
            strCategory = rst!Category
            
            Set tv.Nodes.Item(strCatKey).Parent = tv.Nodes.Item(strBelongsTo)
        End If
        rst.MoveNext
    Loop
    rst.Close
    
    ' Populate ListView Control with Product details
    ' of the first Category Item
    LoadListView firstCatID
    
End Sub


Private Sub LoadListView(ByVal CatID)
    Dim strProduct As String
    Dim strPKey As String
    Dim intcount As Integer
    Dim tmpLItem As MSComctlLib.ListItem
    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    Dim strSQL As String
    
    ' Initialize ListView Control
    While lvList.ListItems.Count > 0
        lvList.ListItems.Remove (1)
    Wend
   
     strSQL = "SELECT lvProducts.* FROM lvProducts "
     strSQL = strSQL & "WHERE (lvProducts.ParentID = " & CatID & ") "
     strSQL = strSQL & "ORDER BY lvProducts.[Product Name];"
    
    'Open filtered Products List for selected category
    Set db = CurrentDb
    Set rst = db.OpenRecordset(strSQL, dbOpenSnapshot)
    
    Do While Not rst.BOF And Not rst.EOF
        intcount = intcount + 1
        strProduct = rst![Product Name]
        strPKey = Prfx & CStr(rst!PID)
        
        'List Item Add() Syntax:
        'lvList.ListItems.Add Index,Key,Text,Icon,SmallIcon
        Set tmpLItem = lvList.ListItems.Add(, strPKey, strProduct, , 3) 'first column
            lvList.ForeColor = vbBlue
            
            'List second column sub-item Syntax:
            'tmpLItem.ListSubItems.Add Column - Index, Key, Text, ReportIcon, ToolTipText
            tmpLItem.ListSubItems.Add 1, strPKey & CStr(intcount), Nz(rst![Quantity Per Unit], ""), 6
            
            'List third column sub-item
            tmpLItem.ListSubItems.Add 2, strPKey & CStr(intcount + 1), Format(rst![list Price], "0.00"), 6, "In Local Currency."
        rst.MoveNext
    Loop
    
    Set db = Nothing
    Set rst = Nothing
    
    If intcount > 0 Then lvList.ListItems(1).Selected = True
    
End Sub

Private Sub TreeView0_NodeClick(ByVal Node As Object)
Dim Cat_ID As String
Cat_ID = Node.Tag

LoadListView Cat_ID

End Sub

Private Sub TreeView0_OLEStartDrag(Data As Object, AllowedEffects As Long)
    Set tv.SelectedItem = Nothing
End Sub

Private Sub TreeView0_OLEDragOver(Data As Object, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)
On Error GoTo TreeView0_OLEDragOver_Err

    Dim nodSelected As MSComctlLib.Node
    Dim nodOver As MSComctlLib.Node
    
    If tv.SelectedItem Is Nothing Then
        'Select a node if one is not selected
        Set nodSelected = tv.HitTest(X, Y)
        If Not nodSelected Is Nothing Then
            nodSelected.Selected = True
        End If
    Else
        If tv.HitTest(X, Y) Is Nothing Then
        'do nothing
        Else
            'Highlight the node the mouse is over
            Set nodOver = tv.HitTest(X, Y)
            Set tv.DropHighlight = nodOver
        End If
    End If
    
TreeView0_OLEDragOver_Exit:
Exit Sub

TreeView0_OLEDragOver_Err:
MsgBox Err & " : " & Err.Description, vbInformation, "TreeView0_OLEDragOver()"
Resume TreeView0_OLEDragOver_Exit
End Sub


Private Sub TreeView0_OLEDragDrop(Data As Object, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)

    Dim tv_nodSource As Node
    Dim tv_nodTarget As Node
    
    Dim strtv_ParentKey As String
    Dim strtv_TargetKey As String
    Dim strListItemKey As String
    Dim strSQL As String
    
    Dim vCatID As Long
    Dim lngPID As Long
    
    On Error GoTo TreeView0_OLEDragDrop_Err
    
    'Get the source/destination Nodes
    Set tv_nodSource = tv.SelectedItem
    Set tv_nodTarget = tv.HitTest(X, Y)
    
        If Not tv_nodTarget Is Nothing Then
            strtv_ParentKey = tv_nodSource.Key
            strtv_TargetKey = tv_nodTarget.Key
                
            If strtv_ParentKey = strtv_TargetKey Then Exit Sub

            'Extract ListItem Key
            strListItemKey = lvList.SelectedItem.Key
                
            'extract Category Record CID Value
            'and ListItem Product ID Key
            vCatID = Val(Mid(tv_nodTarget.Key, 2))
            lngPID = Val(Mid(strListItemKey, 2))
    
            'UPDATE lvProducts Table
            strSQL = "UPDATE lvProducts SET ParentID = " & vCatID & _
            " WHERE PID = " & lngPID
             
            CurrentDb.Execute strSQL, dbFailOnError
                
            Set tv.DropHighlight = Nothing
            tv_nodSource.Selected = True
                
            'Rebuild ListView Nodes
            TreeView0_NodeClick tv_nodSource
                
        Else ' Invalid Target location
            MsgBox "The destination is invalid!", vbInformation
        End If
    
TreeView0_OLEDragDrop_Exit:
Exit Sub

TreeView0_OLEDragDrop_Err:
MsgBox Err & " : " & Err.Description, vbInformation, "TreeView0_OLEDragDrop()"
Resume TreeView0_OLEDragDrop_Exit
End Sub

Private Sub TreeView0_OLECompleteDrag(Effect As Long)
    Set tv.DropHighlight = Nothing
End Sub

Private Sub cmdClose_Click()
    DoCmd.Close
End Sub

The familiar VBA Code Segments.

In the Form_Load() Event Procedure, we initialize the TreeVew, ListView, ImageList Controls.  It creates the ColumnHeadings of the ListView Control, before populating List items in the Listview control.  At the end of this routine, we call the LoadTreeView() subroutine.

The LoadTreeView() subroutine populates the products’ Category Nodes on the TreeView Control, with the records from the lvCategory Table.  Loading Nodes on the TreeView Control is a two-step process.  Why it is so, rather than doing it in one go?  This aspect has been explained in detail on an earlier Page, the 7th link on the list of links give above if you would like to go through it.  Repeating all of them here may not be appropriate.

At the end of the above subroutine, the LoadListView() subroutine has been called with the first Category record’s CID Value 1 as the parameter.

The Product Records with ParentID field value 1  have been filtered and listed on the ListView Control. This procedure was explained in detail in last week’s post, the 8th item, among the List of Links given above.

The Drag-Drop Action Subroutines.

The following Subroutines associated with the Drag and Drop action will be executed automatically in the order they are presented below:

  1. TreeView0_OLEStartDrag()
  2. TreeView0_OLEDragOver()
  3. TreeView0_OLEDragDrop()
  4. TreeView0_OLECompleteDrag()

The first and last Subroutines initialize the Nodes involved and reset their status at the end respectively. 

The second one, OLEDragOver() subroutine works like the MouseMove Event Procedure and tracks the movement of the mouse during the drag-drop operation.  It highlights the NodeText when the mouse is over a Node and tracks its trajectory till the left mouse button gets released.

The TreeView0_OLEDragDrop() procedure code alone is listed below.

Private Sub TreeView0_OLEDragDrop(Data As Object, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)

    Dim tv_nodSource As Node
    Dim tv_nodTarget As Node
    
    Dim strtv_ParentKey As String
    Dim strtv_TargetKey As String
    Dim strListItemKey As String
    Dim strSQL As String
    
    Dim vCatID As Long
    Dim lngPID As Long
    
    On Error GoTo TreeView0_OLEDragDrop_Err
    
    'Get the source/destination Nodes
    Set tv_nodSource = tv.SelectedItem
    Set tv_nodTarget = tv.HitTest(X, Y)
    
        If Not tv_nodTarget Is Nothing Then
            strtv_ParentKey = tv_nodSource.Key
            strtv_TargetKey = tv_nodTarget.Key
                
            If strtv_ParentKey = strtv_TargetKey Then Exit Sub

            'Extract ListItem Key
            strListItemKey = lvList.SelectedItem.Key
                
            'extract Category Record CID Value
            'and ListItem Product ID Key
            vCatID = Val(Mid(tv_nodTarget.Key, 2))
            lngPID = Val(Mid(strListItemKey, 2))
    
            'UPDATE lvProducts Table
            strSQL = "UPDATE lvProducts SET ParentID = " & vCatID & _
            " WHERE PID = " & lngPID
             
            CurrentDb.Execute strSQL, dbFailOnError
                
            Set tv.DropHighlight = Nothing
            tv_nodSource.Selected = True
                
            'Rebuild ListView Nodes
            TreeView0_NodeClick tv_nodSource
                
        Else ' Invalid Target location
            MsgBox "The destination is invalid!", vbInformation
        End If
    
TreeView0_OLEDragDrop_Exit:
Exit Sub

TreeView0_OLEDragDrop_Err:
MsgBox Err & " : " & Err.Description, vbInformation, "TreeView0_OLEDragDrop()"
Resume TreeView0_OLEDragDrop_Exit
End Sub

The Drag Drop Action Step by Step.

The TreeView0_OLEDragDrop() Procedure executes immediately after the left mouse button has been released to complete the Drop Action.  At the beginning of the code, the active and the Target TreeView Node’s references have been saved in tv_nodSource and tv_nodTarget object Variables respectively. 

Next, we perform a check, whether the ListItem has been dropped on a valid TreeView Node or not. If it is dropped on the same source Category Node or on an empty area on the TreeView Control then these moves are not valid.  If it has been dropped in an empty area of the TreeView Control then the tv_nodTarget object variable will contain the value Nothing.  In that case, it displays a message and exit from the Program.

Next, the TreeView Source and Target Node Key Values are being saved in two String Variables.   If both keys are the same then the ListItem dragged and dropped on its own Parent Node (Category Node) on the TreeView Control. The program execution is aborted from proceeding further.

If both Keys are different then it is time to update the change on the Product Record’s ParentID field, with the Target Category Record’s CID Code, and refresh the ListView Items.

The selected ListItem’s Key value (PID field value) has been saved in the strListItemKey  String Variable.

The Category record’s actual CID field value has been extracted from the Target Node, by stripping the prefix character value X and saved in variable vCatID.  This is the Value we will be updating on the Product Record’s ParentID field, in order to place the ListItem under the new Category.

Similarly, the selected List Item’s Product’s Key PID value extracted and saved in Variable lngPID.  This has been used as criteria to filter and pick that particular Product record for updating the ParentID field with vCatID.

An UPDATE Query SQL has been created to filter the record, using the lngPID Code as Criteria, to filter the Product record, and to update the vCatID Value in the ParentID field.

The Execute method of the Currentdb has been called with the SQL and updates the change.

The Highlight of the Node has been reset to the Source Node.

Next, the TreeView0_NodeClick() subroutine has been called with the tv_nodSource as a parameter to reflect the change on the ListView Control.

The Close Button Click will close the Form.

Download Demo Database.

You may download the Demo database, do trial runs, and study the VBA Code.


WISH YOU A VERY HAPPY NEW YEAR.

MS-ACCESS EVENT HANDLING

  1. Withevents MS- Access Class Module
  2. Withevents and Defining Your Own Events
  3. Withevents Combo List Textbox Tab
  4. Access Form Control Arrays And Event
  5. Access Form Control Arrays And Event-2
  6. Access Form Control Arrays And Event-3
  7. Withevents in Class Module for Sub-Form
  8. Withevents in Class Module and Data
  9. Withevents and Access Report Event Sink
  10. Withevents and Report Line Hiding
  11. Withevents and Report-line Highlighting
  12. Withevents Texbox and Command Button
  13. Withevents Textbox Command Button
  14. Withevents and All Form Control Types


Share:

MSA GURU : Access Tips & Tricks App

  • Download Android App 'MSA Guru' Version of LEARN MS-ACCESS TIPS AND TRICKS from Google Play Store.

Want to Post Free Ads on the Web


Translate



PageRank
Subscribe in a reader
Your email address:

Delivered by FeedBurner

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 Graph Charts Query VBA msaccessQuery Calculation Event List Boxes TreeView Control Command Buttons Controls Data Emails and Alerts Form ImageList Control Custom Functions Custom Wizards DOS Commands Data Type Key Object Reference ms-access functions msaccess functions msaccess graphs msaccess reporttricks Command Button ListView Control 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