Access and Word Integration

Recently we’ve been asked by a number of clients including Roofing Consulting Services (Consultants, Richmond, VA), KnoxMarine (Surveyors, Charleston, SC) and Hirschler Fleischer (Attorney, Richmond, VA) to integrate Access with Word. What these companies have in common is that they produce reports to their clients and they want to both standardize the reports across their company and save their report writers time in producing these reports. A side benefit is that all of the necessary data to create the report is now consolidated in the Access Database. Lastly, because we are using Access to determine where Word Template files are held and where the destination reports go (and how they are named), Access is actually functioning as a light document management tool for the entire report creation and management process.

We accomplish this in Access by using a combination of file system objects (you’ll need to register the library in the access modules) and the Word Object Library (you’ll also need to register this.

We extensively use bookmarks throughout the various Word documents and create .doc or .docx ‘template’ files. These are NOT the Word Template files. They are standard word document files we name ‘Report 1 TEMPLATE.docx’ for example. If the user wants to change their template files, they simply open them and change them, taking care not to bother the highlighted bookmarks.

We then create code in Access to copy the template file and name the destination document and place the document where it belongs, often in a file folder with a client id number. Then we scroll through the document replacing the bookmarks with either text from the access database or images from the Access database (actually, Access stores the path and file of the image, not the image itself). Here’s an example of this code…

Function fncLetterToMerge(pLetterToMerge As String, id As Long)

‘pass in a field name in zstblinformation which represents the path to the file to be created

On Error GoTo c12_err

Dim rs As Recordset
Dim strPathAndFileToTemplate As String
Dim strPathAndFileToCreate As String
Dim xENCLOSUREx As String
Dim xGeneralNotesx As String
Dim intAssignedToID As Integer

DoCmd.RunCommand acCmdSaveRecord

If IsNull(DLookup(“PathToReports”, “jobs”, “id = ” & id)) Then
MsgBox “Please supply a path to reports for this file”
Exit Function
End If

‘strPath = DLookup(“defaultexportfolder”, “zstblInformation”)
strPathAndFileToTemplate = DLookup(“defaulttemplatefolder”, “zstblInformation”) & “\” & pLetterToMerge
strPathAndFileToCreate = DLookup(“PathToReports”, “jobs”, “id = ” & id) & “\” & DLookup(“[Job Number]”, “Jobs”, “id = ” & id) & ” – ” & pLetterToMerge

If Right(strPathAndFileToCreate, 4) = “docx” Then
strPathAndFileToCreate = Left(strPathAndFileToCreate, Len(strPathAndFileToCreate) – 14) & “.docx”
Else
strPathAndFileToCreate = Left(strPathAndFileToCreate, Len(strPathAndFileToCreate) – 13) & “.doc”
End If

‘Select Case pLetterToMerge
‘Case Is = “FileNotesMrg”

‘End Select

If FileExists(strPathAndFileToCreate) Then
intReply = MsgBox(“This file already exists. Do you wish to delete and replace with a new version?”, vbOKCancel, “Warning”)
If intReply = 1 Then
Kill strPathAndFileToCreate
Else
Exit Function
End If
End If

intAssignedToID = DLookup(“idtbl_employees”, “tbl_Employees”, “initials = ‘” & DLookup(“[assgn to]”, “jobs”, “id = ” & id) & “‘”)

BuildTemplate:
Dim oWord As Object ‘Word.Application
Dim doc As Object ‘Word.Document
Dim objShapes

Dim xFoundx As String
Dim xRecommendx As String

Set oWord = CreateObject(“Word.Application”)
Set doc = oWord.Documents.Open(strPathAndFileToTemplate)
oWord.Visible = True

doc.SaveAs (strPathAndFileToCreate)

With oWord.ActiveDocument

Select Case pLetterToMerge
Case Is = “XXXXX”

Case Is = “KMSC Photo Sheet – TEMPLATE.docx”
If IsNull(DLookup(“datephotostaken”, “jobs”, “id = ” & [id])) Then
MsgBox “Please enter the date the photos were taken on the main form”
Exit Function
End If

.Bookmarks(“xxClaimNumberxx”).Select
If Not IsNull(DLookup(“[claim number]”, “Jobs”, “id = ” & id)) Then oWord.Selection.Text = DLookup(“[claim number]”, “Jobs”, “id = ” & id)

.Bookmarks(“xxJobNumberxx”).Select
If Not IsNull(DLookup(“[Job Number]”, “Jobs”, “id = ” & id)) Then oWord.Selection.Text = DLookup(“[Job Number]”, “Jobs”, “id = ” & id)

.Bookmarks(“xDatex”).Select
If Not IsNull(DLookup(“[datephotostaken]”, “Jobs”, “id = ” & id)) Then oWord.Selection.Text = DLookup(“[datephotostaken]”, “Jobs”, “id = ” & id)

.Bookmarks(“xDatex”).Select
If Not IsNull(DLookup(“[datephotostaken]”, “Jobs”, “id = ” & id)) Then oWord.Selection.Text = DLookup(“[datephotostaken]”, “Jobs”, “id = ” & id)

‘i = 0
‘Set rs = CurrentDb.OpenRecordset(“select * from trptPhotoSheet where id = ” & id)
‘Do Until rs.EOF
‘ i = i + 1

‘If Not IsNull(rs!PhotoPathAndFile) Then .Bookmarks(“xxPhoto” & i & “xx”).Range.InlineShapes.AddPicture FileName:=rs!PhotoPathAndFile
‘ .Bookmarks(“xxPhoto” & i & “xx”).Select

‘If Not IsNull(rs!PhotoCaption) Then oWord.Selection.Text = rs!PhotoCaption
‘ rs.MoveNext
‘Loop

For i = 1 To 10
If Not IsNull(DLookup(“photo” & i, “Jobs”, “id = ” & id)) Then
.Bookmarks(“xxPhoto” & i & “xx”).Range.InlineShapes.AddPicture FileName:=DLookup(“photo” & i, “Jobs”, “id = ” & id)
‘.Bookmarks(“xxPhoto” & i & “xx”).Select
.Bookmarks(“xxPhotoCaption” & i & “xx”).Select
If Not IsNull(DLookup(“photocaption” & i, “Jobs”, “id = ” & id)) Then oWord.Selection.Text = DLookup(“photocaption” & i, “Jobs”, “id = ” & id)
End If
Next

Posted in Uncategorized | Comments Off on Access and Word Integration

Access Database in the Cloud?

Throughout 2017, we were approached by a number of clients including KnoxMarine (Charleston, SC) and SeniorSmart (Sykesville, MD) to fix their ‘Cloud’ Access databases.  They were both using Microsoft Cloud to hold their Access Database files and were very disappointed with the results.  Primarily because this cloud solution creates a temporary copy of the Access Database on the local workstation, then overwrites the cloud version when the file is closed.

This, of course, means that if two users have the database open simultaneously, when the second user closes their version of the database, the first user’s database changes will be overwritten.

So what is a true Cloud Solution for an Access Database?  Then Answer: SQL Server or MySQL.

What you do is move your tables into SQL Server or MySQL.  This database needs to reside on a server that is on the internet (for instance, The Data Control LLC server we offer for $50/month).  Then modify your Access Database to connect to these tables through the internet.  We’ve done this for API Services (Newport News, VA) and HORWITZ, RICHARDSON & BAKER, LLC (Chicago, IL)

For instance:

 

Public Sub UpdateWebSQLConnections()
On Error GoTo err_Procedure

Dim rs As Recordset
Dim db As Database

Set rs = CurrentDb.OpenRecordset(“Select * from zstjncDataFiles_Tables Where DataFileID = 1”)
Set db = CurrentDb

Dim strWebIP As String
strWebIP = DLookup(“BackEndWebServer”, “zstblInformation”)

While Not rs.EOF
If UpdateSQLConnection(rs!SourceTableName, rs!DisplayTableName, “TCP/IP Address”, “ServerName”, “DatabaseName”, “Password”, “1”) Then
rs.MoveNext
Else
MsgBox “Connecting to SQL Server failed.”
Exit Sub
End If

Wend

    rs.Close
db.Close
exit_Procedure:
Set rs = Nothing
Set db = Nothing
Exit Sub

err_Procedure:
MsgBox Err & “: ” & Err.Description
Resume exit_Procedure

End Sub

If you’d like us to host your database in our cloud, we’ll convert your database for free.  If you want to host your database somewhere else, we’ll give you a price to convert the tables for you and modify your Access Database to use the new tables.

 

Posted in Uncategorized | Comments Off on Access Database in the Cloud?

Managing text communications (with an Access Database)

You can manage your texting using an Access Database. Contact us at www.datacontrolllc.com or jjaeger@datacontrolllc.com to learn more. You can purchase this Access database for $100.00

Posted in Access Code Examples, Microsoft Access Solutions | Tagged , | Comments Off on Managing text communications (with an Access Database)

Banking / Finance Real Estate Loan Portfolio Access Database

So we built this application for 1st Market Bank which has since become Union.  We’ve also sold it to 1st Capital Bank which is now Sterling.

Essentially, the user records all of the relevant information about Customer’s and their loans for real estate construction deals including the development the home is in and then the Bank may run 30 different reports to manage their portfolio.

1st Capital Application 3

The Customer information and small part of the loan information:

1st Capital Application

Example of the Current Outstanding Report:

1st Capital application 2

 

If you’d like a similar database, don’t hesitate to contact us and we can either build you a similar application from scratch, or modify this application to your needs!

 

Posted in Bank database, Uncategorized | Tagged , , , | Comments Off on Banking / Finance Real Estate Loan Portfolio Access Database

Integrating Access with Outlook using automation and vba (Visual Basic for Applications)

So you have a list of emails and you want to keep in contact with folks easily.

I do this by periodically sending out emails to my former clients and offering them incentives to come back and purchase again.  Since I already have their contact information in our Access Database for Invoicing, it makes sense to email them from here as well.

This is an example of an Access Database that interacts with Outlook using Automation and VBA Code.

On the right side, I’ve assigned my contacts and email sequence number:

Email Blast

On the left hand side I’ve created buttons for emailing groups of people based on their email sequence.

The drop down box with ‘Memorial Day Database Consulting Sale’ may be double clicked to open another screen for creating email messages:

email blast message

When you’ve chosen the group of people to email (keep the groups small so you aren’ considered a spammer) and you’ve chosen your message, you may then email the group by choosing one of the ‘Mail to…’ buttons.

This is the code that runs behind the button to send the emails:

=fncSendEmail(1)

Function fncSendEmail(pEmailSequence As Integer) As Boolean
    Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim strDate As String
Dim strAttachment As String
    Dim rs As Recordset

Set rs = CurrentDb.OpenRecordset(“select * from tblHospitalAssociations where EmailSequence = ” & pEmailSequence & ” and Email<>’Unknown'”)
rs.MoveLast
rs.MoveFirst

‘If rs.RecordCount > 3 Then Stop

Set objOutlook = CreateObject(“Outlook.Application”)

Do Until rs.EOF
‘Stop
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg

Set objOutlookRecip = .Recipients.Add(rs![Email])
objOutlookRecip.Type = olTo
.Subject = txtSubject
.Body = txtMessage
If Not IsNull(txtAttachment) Then
strAttachment = txtAttachment
Set objOutlookAttach = .Attachments.Add(strAttachment)
End If                                                              ‘.Importance = olImportanceHigh  ‘High importance
.Display
.Send
‘CurrentDb.Execute “INSERT INTO tbl_Email_History ( ClientID, EmailSentDate, EmailSubject, EmailBody ) ” & _
“SELECT ” & rs!ClientID & “, Date(), ‘” & txtSubject & “‘, ‘” & txtMessage & “‘”

        End With
rs.MoveNext

Loop

    CurrentDb.Execute “UPDATE tbl_Historical_Emails SET [” & pEmailSequence & “s] = True ” & _
“WHERE EmailDate=#” & txtEmaildate & “#”
MsgBox “Done!”
    fncSendEmail = True
End Function
Posted in Uncategorized | Comments Off on Integrating Access with Outlook using automation and vba (Visual Basic for Applications)

Virginia, Henrico County Public Schools Facilities/Projects/Asset Management Database

We’re particularly proud to work with one of the best counties in the United Stated (and the home of Data Control, LLC!) We have built and implemented an Asset / Facility / Project tracking database for Henrico County School Systems.

If you’d like a demonstration of this database to see if it would work for your County, then please call us and set up a shared view session to see a demonstration.

The Processing Choices:

Main Menu

Vehicle Data Entry:

Vehicles

The Reports:

Reports

The Facility Data Report:

Facility Data Report

Posted in Announcements/News, Government Database, Microsoft Access Solutions, Uncategorized | Tagged , , , , , | Comments Off on Virginia, Henrico County Public Schools Facilities/Projects/Asset Management Database

FTP files using Microsoft Access

I have an import/export client that runs their entire operation with Microsoft Access as a backbone application. This company has been in Fastcompany for a couple of years now.

Today I had the opportunity to go back and slightly modify some FTP code to download/upload transaction files.
They sell their merchandise through Amazon, Walmart, Houzz, and more. Today we added Hayneedle.
So I thought I might share the code necessary to perform an FTP transfer.

Please note that this code assumes you have a ‘zstblInformation’ table set up containing the FTP credentials:
strWayfairFTPServer = DLookup(“WayfairFTPSite”, “zstblInformation”)
strWayfairFTPUser = DLookup(“WayfairFTPUser”, “zstblInformation”)
strWayfairFTPPassword = DLookup(“WayfairFTPPassword”, “zstblInformation”)
strWayfairFTPFolder = DLookup(“WayfairFTPFolder”, “zstblInformation”)

Give me a call at 804 928 4111 if you have problems implementing this code.
This code does not require a library to be installed in Access.

Option Compare Database
Option Explicit

‘Open the Internet object
Private Declare PtrSafe Function InternetOpen _
Lib “wininet.dll” _
Alias “InternetOpenA” _
(ByVal sAgent As String, _
ByVal lAccessType As Long, _
ByVal sProxyName As String, _
ByVal sProxyBypass As String, _
ByVal lFlags As Long) As Long

‘Connect to the network
Private Declare PtrSafe Function InternetConnect _
Lib “wininet.dll” _
Alias “InternetConnectA” _
(ByVal hInternetSession As Long, _
ByVal sServerName As String, _
ByVal nServerPort As Integer, _
ByVal sUsername As String, _
ByVal sPassword As String, _
ByVal lService As Long, _
ByVal lFlags As Long, _
ByVal lContext As Long) As Long

‘Get a file using FTP
Private Declare PtrSafe Function FtpGetFile _
Lib “wininet.dll” _
Alias “FtpGetFileA” _
(ByVal hFtpSession As Long, _
ByVal lpszRemoteFile As String, _
ByVal lpszNewFile As String, _
ByVal fFailIfExists As Boolean, _
ByVal dwFlagsAndAttributes As Long, _
ByVal dwFlags As Long, _
ByVal dwContext As Long) As Boolean

‘Send a file using FTP
Private Declare PtrSafe Function FtpPutFile _
Lib “wininet.dll” _
Alias “FtpPutFileA” _
(ByVal hFtpSession As Long, _
ByVal lpszLocalFile As String, _
ByVal lpszRemoteFile As String, _
ByVal dwFlags As Long, _
ByVal dwContext As Long) As Boolean

‘Close the Internet object
Private Declare PtrSafe Function InternetCloseHandle _
Lib “wininet.dll” _
(ByVal hInet As Long) As Integer
Public Sub subPerformFTP(pPathAndFile_To_Send As String, pServerName As Variant, pLogonName As String, pLogonPassword As String, pRemoteDirectory As Variant, pRemoteFileName As String, pUPLOAD_OR_DOWNLOAD As String)

Dim strRemoteDir As String
Dim strRemoteFile As String
Dim strLocalFile As String

Dim strRemoteDir2 As String
Dim strRemoteFile2 As String
Dim strLocalFile2 As String

On Error GoTo Err_f_PerformFTP

DoCmd.Hourglass True

FTPClient.ServerName = pServerName
FTPClient.UserName = pLogonName
FTPClient.Password = pLogonPassword

FTPClient.OpenFTP
FTPClient.OpenServer

Select Case pUPLOAD_OR_DOWNLOAD

Case Is = “Upload”
strRemoteDir = pRemoteDirectory
strRemoteFile = pRemoteFileName
strLocalFile = pPathAndFile_To_Send
FTPClient.PutFile strRemoteDir, strRemoteFile, strLocalFile, “ASC”

Case Is = “Download”
strRemoteDir2 = pRemoteDirectory
strRemoteFile2 = pRemoteFileName
strLocalFile2 = pPathAndFile_To_Send
FTPClient.GetFile strRemoteDir2, strRemoteFile2, strLocalFile2, “ASC”

End Select

FTPClient.CloseServer
FTPClient.CloseFTP

Exit_f_PerformFTP:
DoCmd.Hourglass False
Exit Sub

Err_f_PerformFTP:
MsgBox Err.Number & ” ” & Err.Description, vbCritical, “Error in f_PerformFTP module”
Resume Exit_f_PerformFTP

End Sub

Public Sub subFTPTestWayfair()

Dim strPathFileForUpload As String
Dim strFileForUpload As String

Dim strWayfairFTPServer As String
Dim strWayfairFTPUser As String
Dim strWayfairFTPPassword As String
Dim strWayfairFTPFolder As String

strPathFileForUpload = “Z:\Operations\Wayfair\Inventory\Jackzzz.xlsx”
strFileForUpload = Format(Date, “yymmdd”) & ” Wayfair Inventory FOR FTP.csv”

strWayfairFTPServer = DLookup(“WayfairFTPSite”, “zstblInformation”)
strWayfairFTPUser = DLookup(“WayfairFTPUser”, “zstblInformation”)
strWayfairFTPPassword = DLookup(“WayfairFTPPassword”, “zstblInformation”)
strWayfairFTPFolder = DLookup(“WayfairFTPFolder”, “zstblInformation”)

‘subPerformFTP(pPathAndFile_To_Send As String, pServerName As Variant, pLogonName As String, pLogonPassword As String, pRemoteDirectory As Variant, pRemoteFileName As String, pUPLOAD_OR_DOWNLOAD As String)

‘subPerformFTP strPathFileForUpload, strWayfairFTPServer, strWayfairFTPUser, strWayfairFTPPassword, “Inventory”, strFileForUpload, “Upload”
subPerformFTP strPathFileForUpload, strWayfairFTPServer, strWayfairFTPUser, “PASSWORD”, “inventory”, “jackzzz.xlsx”, “Upload”
MsgBox strPathFileForUpload & ” has been FTP’d.”

End Sub

Public Sub subGetAllFTPFiles(pServerName As Variant, pLogonName As String, pLogonPassword As String, pRemoteDirectory As Variant, pLocalDirectory As Variant, pFileType As Variant)

Dim strRemoteDir As String
Dim strRemoteFile As String
Dim strLocalFile As String

Dim strRemoteDir2 As String
Dim strRemoteFile2 As String
Dim strLocalFile2 As String

On Error GoTo Err_f_GetAllFTPFiles

DoCmd.Hourglass True

FTPClient.ServerName = pServerName
FTPClient.UserName = pLogonName
FTPClient.Password = pLogonPassword

FTPClient.OpenFTP
FTPClient.OpenServer
FTPClient.ClearFileNames
FTPClient.GetFileNames pRemoteDirectory, pFileType

Dim strFileName As String
Dim iFiles As Integer
iFiles = 0
iFiles = FTPClient.FileNames.Count

Dim i As Integer

If iFiles > 0 Then
i = 1
While i <= iFiles
strFileName = FTPClient.FileNames(i)
FTPClient.GetFile pRemoteDirectory, strFileName, pLocalDirectory & “\” & strFileName
i = i + 1
Wend
End If

FTPClient.CloseServer
FTPClient.CloseFTP

Exit_f_GetAllFTPFiles:
DoCmd.Hourglass False
Exit Sub

Err_f_GetAllFTPFiles:
MsgBox Err.Number & ” ” & Err.Description, vbCritical, “Error in f_FindAllFTPFiles module”
Resume Exit_f_GetAllFTPFiles

End Sub

Posted in Access 2007 problems/solutions, Access Code Examples, Microsoft Access Solutions | Tagged , , | Comments Off on FTP files using Microsoft Access

Finding data holes and filling them in Microsoft Access

Finding data holes and filling them in Microsoft Access

So you are running 20 lines of production and you have 3 shifts a day. But some times you don’t run a shift due to a variety of reasons. You decide that during these missed shifts you want to record a shift that SHOULD have run and give that shift a downtime code. You want to use ‘No Demand’ as your downtime code which means that there was no reason to run on that day on that production line during that shift.
By having this ‘No Demand’ data added to your production run data, you’ll be able to more accurately track your efficiency, downtime, and more.

So how do you identify where these holes are in your data and how do you fill these holes? You’ve got 20 machines times 3 shifts a day. That’s 60 potential holes to fill.

Here’s how I approached. Note that the two currentdb.execute “…SQL Code Here…” statements (at the end of the procedure) are creating records. One in the production table and one in a tsub downtime table. Call me at 804 928 4111 with any questions if you want to get this code working for you.
Create a table of all possible production runs for a given period of time:

Historical Shifts Table

 

In code I create this table with a currentdb.execute SQL statement. I put this inside of a For/Next loop that is defined by the most recent date in the table up until today. Therefore I will only have to add the most recent days everytime I run this code.

dtmLastDate = DMax(“ProductionDate”, “tbl_Historical_Shifts”)
iOutStandingDays = Date – dtmLastDate

If iOutStandingDays = 0 Then Exit Sub

CurrentDb.Execute “delete * from tbl_Historical_Shifts”

For i = 1 To iOutStandingDays

CurrentDb.Execute “INSERT INTO tbl_Historical_Shifts ( lineid, ShiftNumber, ShiftOccured, Productiondate ) ” & _
“SELECT tlkp_Lines.lineid, tlkp_Shifts.ShiftNumber, 0 AS ShiftOccured, #” & dtmLastDate + i & “# AS Productiondate ” & _
“FROM tlkp_Lines, tlkp_Shifts”

Next

Note above that I assume the ‘ShiftOccured’ field is false. Therefore I assume that none of the shifts actually ran.

I then run an update query comparing this historical table to the actual production table:

””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””
‘fill in whether or not a production record exists
””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””
CurrentDb.Execute “UPDATE tbl_Historical_Shifts INNER JOIN tbl_Daily_Production ON (tbl_Historical_Shifts.ProductionDate = tbl_Daily_Production.productiondate) AND (tbl_Historical_Shifts.lineid = tbl_Daily_Production.lineid) AND (tbl_Historical_Shifts.ShiftNumber = tbl_Daily_Production.productionshift) SET tbl_Historical_Shifts.ShiftOccured = True”
Which looks like this in design mode:

Design view of sql

At this point, if you reviewed the historical table for 3/14/17, you would find that a few of the shifts did not occur:

Historical Shifts Table

For example the production line BBHAY31 on shift 3 and the BBTUB on shift 2.
So now I create a recordset based on the above table and scroll through that recordset identifying the ‘0’ values in ShiftOccured.
””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””
‘ scroll through the shifts where no production record exists. Build a production record with no demand
””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””
Set rs = CurrentDb.OpenRecordset(“select * from qry_Missing_Shifts WHERE productiondate >=#” & dtmLastDate & “#”)

Do Until rs.EOF
‘build a production record
CurrentDb.Execute “INSERT INTO tbl_Daily_Production ( productiondate, productionshift, starttimeofrun, total_hours ) ” & _
“SELECT #” & rs!ProductionDate & “# AS productiondate, 0 AS productionshift, #12/30/1899 1:0:0# AS starttimeofrun, 8 AS total_hours FROM tbl_Daily_Production”
lngNextProductionID = DMax(“lineid”, “tbl_daily_production”)

‘build a no demand downtime record
‘CurrentDb.Execute “INSERT INTO tsub_Production_Downtime ( productionid, dtcode, explanation, hour1minutes, hour2minutes, hour3minutes, hour4minutes, hour5minutes, hour6minutes, hour7minutes, hour8minutes, totalminutes ) ” & _
“SELECT ” & lngNextProductionID & ” AS productionid, No Demand’ AS dtcode, ‘automated’ AS explanation, 60 AS hour1minutes, 60 AS hour2minutes, 60 AS hour3minutes, 60 AS hour4minutes, 60 AS hour5minutes, 60 AS hour6minutes, 60 AS hour7minutes, 60 AS hour8minutes, 480 AS totalminutes”
rs.MoveNext
Loop

Here’s the entire sub procedure. If you wanted to run this sub procedure, simply create a button on a form (or tie the sub procedure to a form’s on load event if you’d prefer) and call as such:

Creating Button

Private Sub cmdFillHoles_Click()

subCreateNoDemandRecords

End Sub

I then put this sub procedure (subCreateNoDemandRecords) in a global module so it may be called from anywhere in the database including this new button.

Sub subCreateNoDemandRecords()
””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””
‘ Create No Demand Records Where necessary
””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””
Dim dtmLastDate As Date
Dim i As Integer
Dim iOutStandingDays As Integer
Dim rs As Recordset
Dim lngNextProductionID As Long

””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””
‘build a list of all potential days/shifts since the last time this was done
””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””
dtmLastDate = DMax(“ProductionDate”, “tbl_Historical_Shifts”)
iOutStandingDays = Date – dtmLastDate

If iOutStandingDays = 0 Then Exit Sub

CurrentDb.Execute “delete * from tbl_Historical_Shifts”

For i = 1 To iOutStandingDays

CurrentDb.Execute “INSERT INTO tbl_Historical_Shifts ( lineid, ShiftNumber, ShiftOccured, Productiondate ) ” & _
“SELECT tlkp_Lines.lineid, tlkp_Shifts.ShiftNumber, 0 AS ShiftOccured, #” & dtmLastDate + i & “# AS Productiondate ” & _
“FROM tlkp_Lines, tlkp_Shifts”

Next
””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””
‘fill in whether or not a production record exists
””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””
CurrentDb.Execute “UPDATE tbl_Historical_Shifts INNER JOIN tbl_Daily_Production ON (tbl_Historical_Shifts.ProductionDate = tbl_Daily_Production.productiondate) AND (tbl_Historical_Shifts.lineid = tbl_Daily_Production.lineid) AND (tbl_Historical_Shifts.ShiftNumber = tbl_Daily_Production.productionshift) SET tbl_Historical_Shifts.ShiftOccured = True”

””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””
‘ scroll through the shifts where no production record exists. Build a production record with no demand
””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””
Set rs = CurrentDb.OpenRecordset(“select * from qry_Missing_Shifts WHERE productiondate >=#” & dtmLastDate & “#”)

Do Until rs.EOF
‘build a production record
CurrentDb.Execute “INSERT INTO tbl_Daily_Production ( productiondate, productionshift, starttimeofrun, total_hours ) ” & _
“SELECT #” & rs!ProductionDate & “# AS productiondate, 0 AS productionshift, #12/30/1899 1:0:0# AS starttimeofrun, 8 AS total_hours FROM tbl_Daily_Production”
lngNextProductionID = DMax(“lineid”, “tbl_daily_production”)

‘build a no demand downtime record
‘CurrentDb.Execute “INSERT INTO tsub_Production_Downtime ( productionid, dtcode, explanation, hour1minutes, hour2minutes, hour3minutes, hour4minutes, hour5minutes, hour6minutes, hour7minutes, hour8minutes, totalminutes ) ” & _
“SELECT ” & lngNextProductionID & ” AS productionid, No Demand’ AS dtcode, ‘automated’ AS explanation, 60 AS hour1minutes, 60 AS hour2minutes, 60 AS hour3minutes, 60 AS hour4minutes, 60 AS hour5minutes, 60 AS hour6minutes, 60 AS hour7minutes, 60 AS hour8minutes, 480 AS totalminutes”
rs.MoveNext
Loop

MsgBox “Done!”

End Sub

Posted in Access Code Examples, Manufacturing Access Database, Microsoft Access Solutions | Tagged , , | Comments Off on Finding data holes and filling them in Microsoft Access

Calculating travel time between two locations

You need a way to automatically calculate the time to get from one location to another location. You might use this for giving your drivers directions to your clients. Or expand to be an efficient route because you are going to check all the distances between multiple points and go to the close one next, then the next most closest one.

So create a table with 2 columns.  StartLocation, DestinationLocation.  Then create a query based on this table and bring down both columns.  Then create a third column like this: TravelTime:getGoogleTravelTime(StartLocation, DestinationLocation)

Create a module and paste in the following code.  Note that you should not need to set any library references.

That’s it!

Option Compare Database

 

Const strUnits = “imperial” ‘ imperial/metric (miles/km)

‘You need a way to automatically calculate the time to get from one location to another location.  You ‘might use this for giving your drivers directions to your clients.  Or expand to be an efficient route ‘because you are going to check all the distances between multiple points and go to the close one next, ‘then the next most closest one.

 

””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””

‘ Author of this module: desmond oshiwambo

‘ original reference found here: https://desmondoshiwambo.wordpress.com/2013/06/20/how-to-get-google-travel-time-and-distance-in-vba/

””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””’

 

””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””’

‘ Example of calling function:  ?getGoogleTravelTime(“rolling creek place, glen allen,va 23059″,”bar harbor maine”)

’12:51

””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””””’

 

 

 

Function CleanHTML(ByVal strHTML)

 

    ‘Helper function to clean HTML instructions

    Dim strInstrArr1() As String

    Dim strInstrArr2() As String

    Dim s As Integer

    

        strInstrArr1 = Split(strHTML, “<“)

        For s = LBound(strInstrArr1) To UBound(strInstrArr1)

        strInstrArr2 = Split(strInstrArr1(s), “>”)

       If UBound(strInstrArr2) > 0 Then

            strInstrArr1(s) = strInstrArr2(1)

       Else

            strInstrArr1(s) = strInstrArr2(0)

       End If

    Next

     

    CleanHTML = Join(strInstrArr1)

   

End Function

 

 

Public Function formatGoogleTime(ByVal lngSeconds As Double)

‘Helper function. Google returns the time in seconds, so this converts it into time format hh:mm

 

Dim lngMinutes As Long

Dim lngHours As Long

 

lngMinutes = Fix(lngSeconds / 60)

lngHours = Fix(lngMinutes / 60)

lngMinutes = lngMinutes – (lngHours * 60)

 

formatGoogleTime = Format(lngHours, “00”) & “:” & Format(lngMinutes, “00”)

End Function

 

 

Function gglDirectionsResponse(ByVal strStartLocation, ByVal strEndLocation, ByRef strTravelTime, ByRef strDistance, ByRef strInstructions, Optional ByRef strError = “”) As Boolean

On Error GoTo errorHandler

‘ Helper function to request and process XML generated by Google Maps.

 

Dim strURL As String

Dim objXMLHttp As Object

Dim objDOMDocument As Object

Dim nodeRoute As Object

Dim lngDistance As Long

 

Set objXMLHttp = CreateObject(“MSXML2.XMLHTTP”)

Set objDOMDocument = CreateObject(“MSXML2.DOMDocument.6.0”)

 

strStartLocation = Replace(strStartLocation, ” “, “+”)

strEndLocation = Replace(strEndLocation, ” “, “+”)

 

strURL = “http://maps.googleapis.com/maps/api/directions/xml” & _

            “?origin=” & strStartLocation & _

            “&destination=” & strEndLocation & _

            “&sensor=false” & _

            “&units=” & strUnits   ‘Sensor field is required by google and indicates whether a Geo-sensor is being used by the device making the request

 

‘Send XML request

With objXMLHttp

    .Open “GET”, strURL, False

    .setRequestHeader “Content-Type”, “application/x-www-form-URLEncoded”

    .send

    objDOMDocument.loadXML .responseText

End With

 

With objDOMDocument

    If .selectSingleNode(“//status”).Text = “OK” Then

        ‘Get Distance

        lngDistance = .selectSingleNode(“/DirectionsResponse/route/leg/distance/value”).Text ‘ Retrieves distance in meters

        Select Case strUnits

            Case “imperial”: strDistance = Round(lngDistance * 0.00062137, 1)  ‘Convert meters to miles

            Case “metric”: strDistance = Round(lngDistance / 1000, 1) ‘Convert meters to miles

        End Select

        

        ‘Get Travel Time

        strTravelTime = .selectSingleNode(“/DirectionsResponse/route/leg/duration/value”).Text  ‘returns in seconds from google

        strTravelTime = formatGoogleTime(strTravelTime) ‘converts seconds to hh:mm

        

        ‘Get Directions

        For Each nodeRoute In .selectSingleNode(“//route/leg”).childNodes

            If nodeRoute.baseName = “step” Then

                strInstructions = strInstructions & nodeRoute.selectSingleNode(“html_instructions”).Text & ” – ” & nodeRoute.selectSingleNode(“distance/text”).Text & vbCrLf

            End If

        Next

        

        strInstructions = CleanHTML(strInstructions) ‘Removes MetaTag information from HTML result to convert to plain text.

        

    Else

        strError = .selectSingleNode(“//status”).Text

        GoTo errorHandler

    End If

End With

 

gglDirectionsResponse = True

GoTo CleanExit

 

errorHandler:

    If strError = “” Then strError = Err.Description

    strDistance = -1

    strTravelTime = “00:00”

    strInstructions = “”

    gglDirectionsResponse = False

 

CleanExit:

    Set objDOMDocument = Nothing

    Set objXMLHttp = Nothing

 

End Function

 

 

Function getGoogleTravelTime(ByVal strFrom, ByVal strTo) As String

‘Returns the journey time between strFrom and strTo

 

Dim strTravelTime As String

Dim strDistance As String

Dim strInstructions As String

Dim strError As String

 

If gglDirectionsResponse(strFrom, strTo, strTravelTime, strDistance, strInstructions, strError) Then

    getGoogleTravelTime = strTravelTime

Else

    getGoogleTravelTime = strError

End If

 

End Function

 

 

Function getGoogleDistance(ByVal strFrom, ByVal strTo) As String

‘Returns the distance between strFrom and strTo

‘where strFrom/To are address search terms recognisable by Google

‘i.e. Postcode, address etc.

 

Dim strTravelTime As String

Dim strDistance As String

Dim strError As String

Dim strInstructions As String

 

If gglDirectionsResponse(strFrom, strTo, strTravelTime, strDistance, strInstructions, strError) Then

    getGoogleDistance = strDistance

Else

    getGoogleDistance = strError

End If

 

End Function

 

 

Function getGoogleDirections(ByVal strFrom, ByVal strTo) As String

‘Returns the directions between strFrom and strTo

‘where strFrom/To are address search terms recognisable by Google

‘i.e. Postcode, address etc.

 

Dim strTravelTime As String

Dim strDistance As String

Dim strError As String

Dim strInstructions As String

 

If gglDirectionsResponse(strFrom, strTo, strTravelTime, strDistance, strInstructions, strError) Then

    getGoogleDirections = strInstructions

Else

    getGoogleDirections = strError

End If

 

End Function

 

 

 

Posted in Uncategorized | Tagged , , | Comments Off on Calculating travel time between two locations