Check to see if two Ms-Access reports match in VBA? - ms-access

Are there any ways in VBA to check the contents in two access reports to see if they both match?
A less ideal way to do this is to export both reports as a PDF using
DoCmd.OutputTo acOutputReport, "rptMyReport", acFormatPDF, "C:\Reports\MyReport.pdf"
and then have a pdf compare tools such as WinMerge with the xdocdiff plugin analyze the difference. It's not a very streamlined process.
I'm trying to unit test each report by comparing the output of a newer version to an older version of the report to see if anything broke or changed.

This is going to come down to old-fashioned debugging techniques like inserting temporary subtotal fields and other points of comparison.

I'd like to answer my own question. A way to do this is to export your reports as html files using the DoCmd.OutputTo and then read them into a string variable. You can then compare string together from the newer file and older file.
Here is an example code:
Public Function fncCheckMatchingReports(strPathOne As String, strPathTwo As String)
Dim oFSO As Object, oFS1 As Object, oFS2 As Object
Dim sText1 As String, sText2 As String
Set oFSO = CreateObject("Scripting.FileSystemObject")
'Set oFS1 = oFSO.OpenTextFile("C:\Users\Desktop\test.html")
'Set oFS2 = oFSO.OpenTextFile("C:\Users\Desktop\test2.html")
Set oFS1 = oFSO.OpenTextFile(strPathOne)
Set oFS2 = oFSO.OpenTextFile(strPathTwo)
sText1 = oFS1.ReadAll()
sText2 = oFS2.ReadAll()
If sText1 = sText2 Then
fncCheckMatchingReports = True
Else
fncCheckMatchingReports = False
End If
End Function

Related

Access 2016 VBA code to import files with variable names

I am trying to use Access VBA to automate the import (by the push of a button) of daily files that exist in a format like this:
Final_Data_ver20181101063035.xlsx
where the numeric piece translates as: yyyymmddhhmmss.
However, without knowing exactly what time the file was created, Access can't find it. I've been trying something like:
Dim datepiece as String
Dim file as String
datepiece = format(Date,"yyyymmdd")
file = "c:\Users\brian\Final_Data_ver" & datepiece & "*" & ".xlsx"
But I keep getting errors when I try this. It's looking for a file literally named:
Final_Data_ver20181102*.xlsx
Maybe I'm just not able to use wildcards in a statement like this. Any help would be appreciated.
Thanks!
This is an example of how you could find all files like Final_Data_ver20181102*.xlsx in Folder c:\:
Sub Test()
Const TEMPLATE As String = "c:\Final_Data_ver20181102*.xlsx"
Dim filename As String
filename = Dir(TEMPLATE)
Do
If filename = vbNullString Then Exit Do
'Instead of just printing the filename you can use it to import it like you did before.
Debug.Print filename
filename = Dir
Loop
End Sub

Import multiple spreadsheets into Access

I am trying to import all my spreadsheets in a workbook to Access. However, nothing gets imported into Access even though i receive no error message. Everything is working except for the line noted below, where even though it seems like Access is importing the spreadsheets, nothing appears in my table.
Public Sub Import_Excel_Workbook()
Dim strFile As String
Dim StrFldrPath As String
Dim strfilelist() As String
Dim intFile As Integer
Dim filename As String
DoCmd.SetWarnings False
StrFldrPath = "C:\Documents\SPY\New\"
'Loop through the folder & build file list
strFile = Dir(StrFldrPath & "*.xls")
' (commented-out code removed for clarity)
Set objAccess = CreateObject("Access.Application")
objAccess.OpenCurrentDatabase "C:\Documents\Database2.accdb" 'not dynamic yet
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Set objWorkbook = objExcel.Workbooks.Open("C:\Documents\SPY\New\SPY_1.xls") 'not dynamic yet
Set colWorksheets = objWorkbook.Worksheets
'cycle through the list of files
'For intFile = 1 To UBound(strfilelist)
'filename = StrFldrPath & strfilelist(intFile) (removed for the time being)
For Each objWorksheet In colWorksheets
Set objRange = objWorksheet.UsedRange
strWorksheetName = objWorksheet.Name & "!" & objRange.Address(False, False)
'########## LINE BELOW SEEMS TO FAIL ############
objAccess.DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
"S&P", "C:\Documents\SPY\New\SPY_1.xls", True, strWorksheetName 'not dynamic yet
Next
'Next intFile
DoCmd.SetWarnings True
End Sub
It looks like you are trying to follow this approach: http://blogs.technet.com/b/heyscriptingguy/archive/2008/01/21/how-can-i-import-multiple-worksheets-into-an-access-database.aspx. It's important to note this technique lets you import all tabs (worksheets).
As suggested in a comment, you must avoid setting SetWarnings to False. You can't trouble shoot when you are suppressing errors.
Your post has a lot of code that doesn't relate to your issue. Please check https://stackoverflow.com/help/mcve for how to ask in a way that encourages answers.
Having said all that, I suggest you change your tab (worksheet) name so it does not contain the symbol &.
If that does not solve your problem, try using the Access import wizard on your problem tab . If you don't have experience with imports, be aware there are many "gotchas". Your source document needs to be free of merged cells, incoherent header-row entries, and countless other snags. The import wizard may reveal some problem with the source data.
Finally, if the source worksheet is empty (none of the cells have values), the import will halt at that point. (This is not the behavior you are reporting, but it's worth a mention.)

How to copy the contents of an attached file from an MS Access DB into a VBA variable?

Background Information:
I am not very savvy with VBA, or Access for that matter, but I have a VBA script that creates a file (a KML to be specific, but this won't matter much for my question) on the users computer and writes to it using variables that link to records in the database. As such:
Dim MyDB As Database
Dim MyRS As Recordset
Dim QryOrTblDef As String
Dim TestFile As Integer
QryOrTblDef = "Table1"
Set MyDB = CurrentDb
Set MyRS = MyDB.OpenRecordset(QryOrTblDef)
TestFile = FreeFile
Open "C:\Testing.txt"
Print #TestFile, "Generic Stuff"
Print #TestFile, MyRS.Fields(0)
etc.
My Situation:
I have a very large string(a text document with a large list of polygon vertex coordinates) that I want to add to a variable to be printed to another file (a KML file, noted in the above example). I was hoping to add this text file containing coordinates as an attachment datatype to the Access database and copy its contents into a variable to be used in the above script.
My Question:
Is there a way I can access and copy the data from an attached text file (attached as an attachment data type within a field of an MS Access database) into a variable so that I can use it in a VBA script?
What I have found:
I am having trouble finidng information on this topic I think mainly because I do not have the knowledge of what keywords to be searching for, but I was able to find someones code on a forum, "ozgrid", that seems to be close to what I want to do. Though it is just pulling from a text file on disk rather than one attached to the database.
Code from above mentioned forum that creates a function to access data in a text file:
Sub Test()
Dim strText As String
strText = GetFileContent("C:\temp\x.txt")
MsgBox strText
End Sub
Function GetFileContent(Name As String) As String
Dim intUnit As Integer
On Error Goto ErrGetFileContent
intUnit = FreeFile
Open Name For Input As intUnit
GetFileContent = Input(LOF(intUnit), intUnit)
ErrGetFileContent:
Close intUnit
Exit Function
End Function
Any help here is appreciated. Thanks.
I am a little puzzled as to why a memo data type does not suit if you are storing pure text, or even a table for organized text. That being said, one way is to output to disk and read into a string.
''Ref: Windows Script Host Object Model
Dim fs As New FileSystemObject
Dim ts As TextStream
Dim rs As DAO.Recordset, rsA As DAO.Recordset
Dim sFilePath As String
Dim sFileText As String
sFilePath = "z:\docs\"
Set rs = CurrentDb.OpenRecordset("maintable")
Set rsA = rs.Fields("aAttachment").Value
''File exists
If Not fs.FileExists(sFilePath & rsA.Fields("FileName").Value) Then
''It will save with the existing FileName, but you can assign a new name
rsA.Fields("FileData").SaveToFile sFilePath
End If
Set ts = fs.OpenTextFile(sFilePath _
& rsA.Fields("FileName").Value, ForReading)
sFileText = ts.ReadAll
See also: http://msdn.microsoft.com/en-us/library/office/ff835669.aspx

Access Mail Merge to different documents based on specific criteria

I'm trying to figure out if there is a way to take a code that I have for merging to a document and set up an if...then that will merge to a different document based on a specific text in a field in a table.
My code that works.
Sub SendConfirmation_Click(CourseNumber As Index)
DoCmd.SetWarnings False
DoCmd.OpenQuery "ConfirmationMailMerge"
Dim LevelIConf As String
Dim OpenWord As Object
'Path to word document
LevelIConf = "G:\POSTPROFESSIONAL\NAIOMT\Classes\PTH536 Level I\LevelIConf.doc"
'Create instance of Word
Set OpenWord = CreateObject("Word.Application")
OpenWord.Visible = True
'Open the document
OpenWord.Documents.Open FileName:=LevelIConf
DoCmd.SetWarnings True
End Sub
I have several Courses that I send out confirmation letters for and each letter is different based on the course. I would like to be able to push a button on the form and have correct document come up based on the course number.
Any help is appreciated. I am a self taught coder and still have lots to learn.
Thanks,
Please note I provide generic solution that may need to be adapted depending on your actual requirements/setup.
Option 1: Your approach (using Word's mail-merge)
You need the following setup:
Two related tables:
Query that returns path to the Conf Letter based on Course ID:
Function that calls the query from previous step:
Function GetConfLetterPathByCourseID(CourseID As Integer) As String
GetConfLetterPathByCourseID = ""
Dim qdf As QueryDef
Dim rs As Recordset
Set qdf = CurrentDb.QueryDefs("GetConfLetterPathByCourseId")
qdf.Parameters("CourseID_par") = CourseID
Set rs = qdf.OpenRecordset
If rs.RecordCount > 0 Then
GetConfLetterPathByCourseID = rs("ConfLetterPath")
End If
End Function
Form with the Send button. Something like this:
And, finally, the Sub for the Send Button:
Sub ConfLetterButton_Click()
DoCmd.SetWarnings False
Dim LevelIConf As String
Dim OpenWord As Object
'Path to word document
LevelIConf = GetConfLetterPathByCourseID(Me.CourseID)
'Create instance of Word
Set OpenWord = CreateObject("Word.Application")
OpenWord.Visible = True
'Open the document
OpenWord.Documents.Open FileName:=LevelIConf
DoCmd.SetWarnings True
End Sub
Please note, I altered slightly your code (e.g. removed Index type, removed Docmd.OpenQuery)
Option 2: Compose email in VBA code and attach the Conf Letter doc file using the Query/Function from option 1. I think this link from Microsoft can provide some details. I did implement similar solution in the past. Worked pretty well.

Opening PDF on specific page number in VBA

I am trying to create a button on my access form that allows for the user to view the corresponding page that goes with the data within the form (In this case, a part number is displayed on the form, and I want the button to open the Part Standard file to show the blueprint/diagram of said part)
I have tried using Adobe's page parameters #page=pagenum at the end of my filepath, but doing this doesn't work.
Here is the code I have (Basic, I know) but I'm trying to figure out where to go here. I have simple condensed down my filepath, for obvious reasons - Note: It's not a URL, but a file path if this matters.
Private Sub Command80_Click()
Dim loc As String 'location of file
'loc = Me.FileLoc
loc = "G:\*\FileName.pdf#page=1"
Debug.Print loc
'Debug.Print Me.FileLoc
'Debug.Print Me.FileName
Application.FollowHyperlink loc
End Sub
Is this possible to do this way? I will continue to read other users posts in hopes to find a solution, and I'll note here if I do find one.
Thanks!
Update
I've found a way to do this, just I have 1 small complication now. My database will be accessed by many users, possibly with different versions of Acrobat, or different locations. Here is my working code:
Private Sub Command2_Click()
pat1 = """C:\Program Files\Adobe\Reader 9.0\Reader\AcroRd32.exe"""
pat2 = "/A ""page=20"""
pat3 = """G:\*\FileName.pdf"""
Shell pat1 & " " & pat2 & " " & pat3, vbNormalFocus
End Sub
Now, here is my concern. This code opens AcroRd32.exe from a specific file path, if my users have this stored elsewhere or have a different version, this won't work. Does anyone have a suggestion as how to possibly get around this?
Thanks again! :)
The correct way to do this is probably to look up the location of the acrobat reader executable in the system registry. I find that's generally more trouble than it's worth, especially if I have some control over all of the places my program will be installed (within a single intranet, for example). Usually I end up using this function that I wrote:
'---------------------------------------------------------------------------------------
' Procedure : FirstValidPath
' Author : Mike
' Date : 5/23/2008
' Purpose : Returns the first valid path found in a list of potential paths.
' Usage : Useful for locating files or folders that may be in different locations
' on different users' computers.
' Notes - Directories must be passed with a trailing "\" otherwise the function
' will assume it is looking for a file with no extension.
' - Returns Null if no valid path is found.
' 5/6/11 : Accept Null parameters. If all parameters are Null, Null is returned.
'---------------------------------------------------------------------------------------
'
Function FirstValidPath(ParamArray Paths() As Variant) As Variant
Dim i As Integer
FirstValidPath = Null
If UBound(Paths) - LBound(Paths) >= 0 Then
For i = LBound(Paths) To UBound(Paths)
If Not IsNull(Paths(i)) Then
If Len(Dir(Paths(i))) > 0 Then
FirstValidPath = Paths(i)
Exit For
End If
End If
Next i
End If
End Function
The function takes a parameter array so you can pass it as many or as few paths as necessary:
PathToUse = FirstValidPath("C:\Program Files\Adobe\Reader 9.0\Reader\AcroRd32.exe", _
"C:\Program Files\Acrobat\Reader.exe", _
"C:\Program Files (x86)\Acrobat\Reader.exe", _
"C:\Program Files\Acrobat\12\Reader.exe")
pat1 = """" & PathToUse & """"
Registry keys are the better way to go, unlike file locations they have consistency between systems.
Below are three functions, two in support of one, and a macro which tests the functions.
GetARE() (Get Adobe Reader Executable) returns the proper path based on a version search in a pre-defined location passed as the argument. This removes the hassle of typing out many different key locations for each version and provides some amount of coverage should future versions be released and installed on a user's system.
I have installed previous versions of Reader to test whether or not the there is consistency in the InstallPath key location, up until quite outdated versions, there is. In fact, mwolfe02 and I both have our keys in the same location, though I am using version 11 and he, at the time of writing, was using 10. I was only able to test this on a x64 system, but you can easily modify the code below to search for both x64 and x86 keys. I expect a large corporation like Adobe to stick to their conventions, so this will likely work for quite some time without much modification even as new versions of Reader are released.
I wrote this quickly, expect inefficiency and inconsistency in naming conventions.
Truly the best approach to ensure the path is almost-always returned would be to simply run a registry search through VBA in a loop for version numbers using "*/Acrobat Reader/XX.YY/InstallPath/" and then including the executable based on a check for the appropriate candidate in the appropriate directory; however, this isn't exactly a very cost-effective solution. My tests have shown that there is quite a bit of consistency between versions as to where the Install Path can be found, and as to what the executable name may be, so I opted for something more efficient if less lasting.
RegKeyRead() and RegKeyExists() were taken from:
http://vba-corner.livejournal.com/3054.html
I have not modified their code. Take into consideration saying thanks to the author of that post, the code is not complex by any means but it did save me the hassle of writing it myself.
Function RegKeyRead(i_RegKey As String) As String
Dim myWS As Object
On Error Resume Next
'access Windows scripting
Set myWS = CreateObject("WScript.Shell")
'read key from registry
RegKeyRead = myWS.RegRead(i_RegKey)
End Function
Function RegKeyExists(i_RegKey As String) As Boolean
Dim myWS As Object
On Error GoTo ErrorHandler
'access Windows scripting
Set myWS = CreateObject("WScript.Shell")
'try to read the registry key
myWS.RegRead i_RegKey
'key was found
RegKeyExists = True
Exit Function
ErrorHandler:
'key was not found
RegKeyExists = False
End Function
Function GetARE(i_RegKey As String) As String
Dim InPath As String
Dim InKey As String
Dim Ind As Integer
Dim PriVer As String
Dim SubVer As String
Dim Exists As Boolean
Exists = False
PriVer = 1
SubVer = 0
For Ind = 1 To 1000
If SubVer > 9 Then
PriVer = PriVer + 1
SubVer = 0
End If
Exists = RegKeyExists(i_RegKey + "\" + PriVer + "." + SubVer + "\InstallPath\")
SubVer = SubVer + 1
If Exists = True Then
SubVer = SubVer - 1
InKey = i_RegKey + "\" + PriVer + "." + SubVer + "\InstallPath\"
InPath = RegKeyRead(InKey)
GetARE = InPath + "\AcroRd32.exe"
Exit For
End If
Next
End Function
Sub test()
Dim rando As String
rando = GetARIP("HKEY_LOCAL_MACHINE\SOFTWARE\Wow6432Node\Adobe\Acrobat Reader")
MsgBox (rando)
End Sub
I remember that Acrobat reader used to include some ActiveX PDF reader object available for further use with Microsoft Office. Other companies have developed similar products, some of them (in their basic form) even available for free.
That could be a solution, couldn't it? You'd have then to check that your activeX PDF reader supports direct page access in its methods, and distribute it with your apps, or have it installed on your user's computers. It will avoid you all the overhead related to acrobat readers versions follow-up, specially when newer versions will be available on the market and you'll have to update your client interface.
Just to add to mwolfe02's answer, here is a function that tries to retrieve the executable for the file type given (it also uses the registry commands Levy referenced) :
Function GetShellFileCommand(FileType As String, Optional Command As String)
Const KEY_ROOT As String = "HKEY_CLASSES_ROOT\"
Dim sKey As String, sProgramClass As String
' All File Extensions should start with a "."
If Left(FileType, 1) <> "." Then FileType = "." & FileType
' Check if the File Extension Key exists and Read the default string value
sKey = KEY_ROOT & FileType & "\"
If RegKeyExists(sKey) Then
sProgramClass = RegKeyRead(sKey)
sKey = KEY_ROOT & sProgramClass & "\shell\"
If RegKeyExists(sKey) Then
' If no command was passed, check the "shell" default string value, for a default command
If Command = vbNullString Then Command = RegKeyRead(sKey)
' If no Default command was found, default to "Open"
If Command = vbNullString Then Command = "Open"
' Check for the command
If RegKeyExists(sKey & Command & "\command\") Then GetShellFileCommand = RegKeyRead(sKey & Command & "\command\")
End If
End If
End Function
so,
Debug.Print GetShellFileEx("PDF")
outputs:
"C:\Program Files (x86)\Adobe\Reader 11.0\Reader\AcroRd32.exe" "%1"
and you just have to replace the "%1" with the file you want to open and add any parameters you need.
Here is code the probably you can use..
Private Sub CommandButton3_Click()
Dim strFile As String
R = 0
If TextBox7 = "CL" Then
R = 2
' Path and filename of PDF file
strFile = "E:\Users\Test\Cupertino Current system.pdf"
ActiveWorkbook.FollowHyperlink strFile
End If
if R = 0 Then
MsgBox "Wrong Code"
ComboBox1 = ""
TextBox1 = Empty
'ComboBox1.SetFocus
End If
End Sub
Just need to the right path.. Hope this can help you