I have designed a system that is used to track customer activity and log calls to a department. The front end and back end database are written in access. This system is due to go to the USA division of the company i work for.
The front end needs to automatically refresh the tables and if the backend database has moved (which it will when i send it to the US) the code will then look at a function to read the location of the new database. Sample of the read text file function code shown below:
Function ReadDbPassword()
'--
' Filetostring(FILEInput$ as variant) ' to make this a callable function
Dim FILEInput As Variant
'--
On Error GoTo FileToString_Error
FILEInput = "C:\Users\Public\databaseUser\PassCon"
Passmyfile = FreeFile
Open FILEInput For Input As Passmyfile
Passthedata4 = Input(LOF(Passmyfile), Passmyfile)
Close Passmyfile
On Error GoTo 0
Exit Function
FileToString_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ")"
End Function
The text file contains a path like the one below:
P:\Projects\Database.accdb
I have found code that uses a similar idea to what i want and i have been looking at the code on the link below, however i do not fully understand how this code works in order to alter it to what I need to use the read text file.
http:/ /access.mvps.org/access/tables/tbl0009.htm
-------EDIT --------
I have tried to edit the following section to use the read text function
Function fGetMDBName(strIn As String) As String
'Calls GetOpenFileName dialog
Dim strFilter As String
strFilter = ahtAddFilterItem(strFilter, _
"Access Database(*.mdb;*.mda;*.mde;*.mdw) ", _
"*.mdb; *.mda; *.mde; *.mdw")
strFilter = ahtAddFilterItem(strFilter, _
"All Files (*.*)", _
"*.*")
fGetMDBName = ahtCommonFileOpenSave(Filter:=strFilter, _
OpenFile:=True, _
DialogTitle:=strIn, _
Flags:=ahtOFN_HIDEREADONLY)
End Function
By replacing all the code with
fGetMDBName = Passmyfile
You are mixing apples and oranges in what you are trying to do. Here are my suggestions:
Make sure your module has 'Option Explicit' then compile all your code. I see variables referenced but have no idea what TYPE they are.
Change your Function 'ReadDbPassword()' to return a string variable, then set it to return Passthedata4.
The second Function you listed (fGetMDBName) is opening a File Dialog box to allow you to select a file name. You do not need that since you already will have the file path/name from your first Function.
Then adapt the code you found that does the relink to use the path/name from your subroutine.
Related
I am completely new to scripting, so please forgive my ignorance.
(Running Windows 10)
I found a working solution to convert .xls files to .csv using the .vbs from this post:
Convert xls to csv.
The files I'm working with have multiple sheets, and the vbs works by dragging the file(s) onto the vbs file icon to execute. I don't understand how the vbs gets the input arguments. I copied this code posted by Chris Rudd
'Courtesy of Chris Rudd on stackoverflow.com
'Modified by Christian Lemer
'plang
'ScottF
' https://stackoverflow.com/questions/1858195/convert-xls-to-csv-on-command-line
'* Usage: Drop .xl* files on me to export each sheet as CSV
'* Global Settings and Variables
'Dim gSkip
Set args = Wscript.Arguments
For Each sFilename In args
iErr = ExportExcelFileToCSV(sFilename)
' 0 for normal success
' 404 for file not found
' 10 for file skipped (or user abort if script returns 10)
Next
WScript.Quit(0)
Function ExportExcelFileToCSV(sFilename)
'* Settings
Dim oExcel, oFSO, oExcelFile
Set oExcel = CreateObject("Excel.Application")
Set oFSO = CreateObject("Scripting.FileSystemObject")
iCSV_Format = 6
'* Set Up
sExtension = oFSO.GetExtensionName(sFilename)
if sExtension = "" then
ExportExcelFileToCSV = 404
Exit Function
end if
sTest = Mid(sExtension,1,2) '* first 2 letters of the extension, vb's missing a Like operator
if not (sTest = "xl") then
if (PromptForSkip(sFilename,oExcel)) then
ExportExcelFileToCSV = 10
Exit Function
end if
End If
sAbsoluteSource = oFSO.GetAbsolutePathName(sFilename)
sAbsoluteDestination = Replace(sAbsoluteSource,sExtension,"{sheet}.csv")
'* Do Work
Set oExcelFile = oExcel.Workbooks.Open(sAbsoluteSource)
For Each oSheet in oExcelFile.Sheets
sThisDestination = Replace(sAbsoluteDestination,"{sheet}",oSheet.Name)
oExcelFile.Sheets(oSheet.Name).Select
oExcelFile.SaveAs sThisDestination, iCSV_Format
Next
'* Take Down
oExcelFile.Close False
oExcel.Quit
ExportExcelFileToCSV = 0
Exit Function
End Function
Function PromptForSkip(sFilename,oExcel)
if not (VarType(gSkip) = vbEmpty) then
PromptForSkip = gSkip
Exit Function
end if
Dim oFSO
Set oFSO = CreateObject("Scripting.FileSystemObject")
sPrompt = vbCRLF & _
"A filename was received that doesn't appear to be an Excel Document." & vbCRLF & _
"Do you want to skip this and all other unrecognized files? (Will only prompt this once)" & vbCRLF & _
"" & vbCRLF & _
"Yes - Will skip all further files that don't have a .xl* extension" & vbCRLF & _
"No - Will pass the file to excel regardless of extension" & vbCRLF & _
"Cancel - Abort any further conversions and exit this script" & vbCRLF & _
"" & vbCRLF & _
"The unrecognized file was:" & vbCRLF & _
sFilename & vbCRLF & _
"" & vbCRLF & _
"The path returned by the system was:" & vbCRLF & _
oFSO.GetAbsolutePathName(sFilename) & vbCRLF
sTitle = "Unrecognized File Type Encountered"
sResponse = MsgBox (sPrompt,vbYesNoCancel,sTitle)
Select Case sResponse
Case vbYes
gSkip = True
Case vbNo
gSkip = False
Case vbCancel
oExcel.Quit
WScript.Quit(10) '* 10 Is the error code I use to indicate there was a user abort (1 because wasn't successful, + 0 because the user chose to exit)
End Select
PromptForSkip = gSkip
Exit Function
End Function
This works well for my needs, but I want to run it hourly and save the .csv files to a new directory.
I tried to run the .vbs using the Task Scheduler, but it only opens the file in my text editor, it doesn't execute. My thought was to create a .batch file that runs the .vbs. I thought I could call the .vbs with PowerShell commands like this:
Start "XlsToCsv"
Start "XlsToCsv.vbs"
But both of those have the same effect of opening the .vbs in the text editor.
Perhaps a simpler question is, "How do I run a .vbs file from the PowerShell or the Command Prompt?"
Any help would be greatly appreciated.
This method works consistently in the batch environment, however cannot use doublequotes as would be advisable for filepaths with spaces.
Start filepath\name.vbs
no Doublequotes.
This method works Consistently in cmd.exe console, however fails in .bat programs:
WSscript.exe "filepath\name.vbs"
Wscript/Window Script host provides an environment to execute scripts in a variety of languages and Cscript starts a script in command line environment.
So, If you want to run your script in console use cscript.exe and wscript.exe if you don't want the console window. So, as T3RR0R mentioned you need to use WScript command to run it.
Sometimes, executing a VBscript in windows opens text editor rather than running it. This is due to changes in the default file associations. Some time antivirus will also do this in order to protect your system. In that case, you need to change the registry check this link https://superuser.com/questions/1108349/change-default-program-for-opening-vbs-files
Take look in this file.gif:
I'm understood that this only works if you're using the file vbs by Drag and Drop passing as arguments...
You can see instructions left by author about how to use in the vbs in 7rd line:
Drop .xl* files on me to export each sheet as CSV
Obs.: .xl* is equal to "any file with (.xl)"+any" == *.xlsx, *.xlsm...
Take look in this file.gif that you can see how to pass arguments in vbs, (is the same to cmd & bat) files by Drag and Drop:
This file.png show how to use arguments with the
The code you have tried are not using/passing any arguments (parameters), without pass any arguments, (one or more files) this will always fail!
If you need try using some like:
"XlsToCsv.vbs" "one_file_dot.extensio_equal_xlsx_.xlsx" "one_more_another_file_dot.extensio_equal_xlsx_too.xlsx"
rem :: observing if you are try in a different folder where the vbs + xlsx file are, try this:
"d:\folder\where\vbs\are\XlsToCsv.vbs" "d:\folder\where\xlsx\file1\are\1file_dot.extension_equal_xlsx_.xlsx" "d:\folder\where\xlsx\file1\are\one\more\are\too\one_more_another_file_dot.extensio_equal_xlsx_too.xlsx"
__
This is who I have using your vbs files in same folder where the files **.xlsx* are, so, no need passing the drive\folder path:
wscript 58924333.vbs "012019.xlsx" "022019.xlsx"
rem :: or ::
cscript 58924333.vbs "012019.xlsx" "022019.xlsx"
So sorry my limited English
I've been using the Access "On Not In List" event for a long time. It allows you to limit the items in your combo box to a particular list, but allows the user to add an item to combo's record source on the fly if they want to enter something that isn't already there. You set the "Limit To List" property of the combo box to Yes, but then you put some code behind the "On Not In List" event. Intermittently, I get a situation in Access 2016 where this doesn't seem to work. I get the standard "The item is not in the list." error when trying to enter a new item, without my code-behind logic being seen and called. What's up?
After banging my head against the wall for a long time, I believe this is bug in Access 2016 and I think I stumbled on a fix. I set the form's RecordSetType property to Snapshot, closed and saved form, reopened the form in design view, set the RecordSetType property back to Dynaset. This seems to have cleared up the problem. I have no idea why.
But since I'm here. . . some additional details: In the code-behind for each control I use code like this:
Private Sub VendorID_NotInList(NewData As String, Response As Integer)
Response = RU_NotInList("Lookup Vendor", "Description", NewData, gc_strMsgCap)
End Sub
This type of subroutine gets created automatically behind the "On Not In List" event, when you click on the 'code builder' option. I have mine call a utility function that I wrote a long time ago. ("RU" refers a code library.)
The function returns an intrinsic Access integer constant that gets passed straight back to Access to handle.
The inside of that routine looks like this:
Function RU_NotInList(TableName As String, FieldName As String, newdata As String, Optional pstrTile As String) As Integer
Dim rs As DAO.Recordset, db As DAO.Database, n1 As Integer
RU_NotInList = DATA_ERRCONTINUE
On Error GoTo RU_NotInList_Error
If Len(Trim(newdata)) = 0 Then Exit Function
n1 = MsgBox(newdata & " is not in the list. Do you wish to add it?", MB_ICONQUESTION + MB_YESNO, pstrTile)
If n1 = IDNO Then Exit Function
Dim strSQL As String
strSQL = "INSERT INTO [" & TableName & "] ([" & FieldName & "]) VALUES (""" & newdata & """)"
WarningsHour True 'Turns hourglass cursor on, warning messages off.
DoCmd.RunSQL strSQL
WarningsHour False 'Undoes the above.
RU_NotInList = DATA_ERRADDED
Exit Function
RU_NotInList_Error:
RUError "RU_NotInList", Err 'generic error-handling routine in the RU library
Exit Function
End Function
All the all-caps items in the code above are Access intrinsic constants.
I am getting the User Defined Type not Defined error with the VBA code below.
I didn't write it and don't know how to fix it, but I need to use the file. It's an access database that requires users to log-in. I can't even log in (this is the error I get when I try), let alone import a file.
Can anyone help?
Public Sub RefreshPrograms(pXML As MSXML2.DOMDocument)
Dim sql As String
Dim iNode As MSXML2.IXMLDOMNode
Dim tnode As MSXML2.IXMLDOMNode
Set iNode = pXML.selectSingleNode("//ProgramUrl")
Set tnode = pXML.selectSingleNode("//" & mProgramNameTag)
If iNode Is Nothing Then
MsgBox "The file you attempted to import is not a valid program list file. You must download the program list file from the ASN RDA Information Server and then import it into the database. If you are trying to import a PoPS assessment XML file, return to the Program Selection window and click 'Import Assessment from XML'.", vbExclamation, "Invalid Program List File"
ElseIf tnode Is Nothing Then
MsgBox "The file you attempted to import is not a valid " & mName & " program list file. You must download the program list file from the ASN RDA Information Server and then import it into the database. If you are trying to import a PoPS assessment XML file, return to the Program Selection window and click 'Import Assessment from XML'.", vbExclamation, "Invalid Program List File"
Else
mURL = iNode.Text
For Each iNode In pXML.selectNodes("//" & mProgramNameTag)
sql = "INSERT INTO TempRemotePrograms (SourceID,RemoteID,Name,ACAT,Organization,PM,PEO) " & _
"Values(" & JoinStrings(True, mID, ReadLongElement(iNode, ID_COLUMN_XML_NAME), ReadStringElement(iNode, "ProgramName"), fACAT.FindByName(ReadStringElement(iNode, "ACAT")).ID, ReadStringElement(iNode, "OrganizationCode"), ReadStringElement(iNode, "PMName"), ReadStringElement(iNode, "PEOName")) & ")"
CurrentDb.Execute sql, dbFailOnError
Next
If DCount("RemoteID", "TempRemotePrograms") > 0 Then
ClearDeletedPrograms
UpdateProgramInfo
InsertNewProgramInfo
mLastUpdated = Now()
Save
End If
End If
Set iNode = Nothing
End Sub
In the VBA Editor, menu Tools -> References, activate Microsoft XML, v6.0
The missing reference generates the compile error.
If you need to edit the code, check out the msxml tag info.
I have been using the following command to open another MDB Access file via VBA:
Shell "cmd /c " & Chr(34) & strNewFullPath & Chr(34), vbHide
strNewFullPath is the full path of the MDB file.
Works fine when using Access 2010, but doesn't run on Access 2003.
If I run the command in a XP DOS terminal it DOES run.
What other command can I use that should work on Access 2003 up and with the Access Runtime?
If you want want to use Access VBA to open a database in another Access application instance, you can do this:
Dim objApp As Access.Application
Set objApp = New Access.Application
objApp.UserControl = True
objApp.OpenCurrentDatabase "C:\Access\sample.mdb"
Set objApp = Nothing
Setting UserControl to True leaves the new application instance open after the procedure finishes.
If you want the new Access instance hidden, include:
objApp.Visible = False
I'm suggesting this approach because it also gives you a way to automate the new application instance through the objApp object variable. But, if you're not interested in automating the new instance, this approach will probably only be useful if you can't make any other method work.
Try using Windows Scripting Host Object Model (WSHOM):
Sub RunFile(filename As String)
Dim oShell As Object
Set oShell = GetShell
If Not oShell Is Nothing Then
oShell.Run filename
End If
End Sub
Function GetShell() As Object
On Error Resume Next
Set GetShell = CreateObject("WScript.Shell")
End Function
The Windows file association should allow both types of files to open in their native application.
Sample Usage:
RunFile strNewFullPath
Optional Arguments:
There are two optional arguments for the Run method. Please note that much of this is copied from MSDN:
intWindowStyle (integer)
A number from 0 to 10:
0 - Hides the window and activates another window.
1 - Activates and displays a window. If the window is minimized or maximized, the system
restores it to its original size and position. An application should
specify this flag when displaying the window for the first time.
2 - Activates the window and displays it as a minimized window.
3 - Activates the window and displays it as a maximized window.
4 - Displays a window in its most recent size and position. The active
window remains active.
5 - Activates the window and displays it in its current size and position.
6 - Minimizes the specified window and activates the next top-level window in the Z order.
7 - Displays the window as a minimized window. The active window remains active.
8 - Displays the window in its current state. The active window remains active.
9 - Activates and displays the window. If the window is minimized or maximized, the system restores it to its original size and position. An application should specify this flag when restoring a minimized window.
10 - Sets the show-state based on the state of the program that started the application.
I am not aware of the default value for this parameter. Note that some programs simply ignore whatever value you set (I couldn't tell you which ones).
bWaitOnReturn (boolean)
Set to False for asynchronous code. The Run method returns control to the calling program before completing. Default is False.
You can use the Win32 API to find the EXE name associated with the file type and prepend it to your shell command like this:
Private Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long
Public Function GetExecutableForFile(strFileName As String) As String
Dim lngRetval As Long
Dim strExecName As String * 255
lngRetval = FindExecutable(strFileName, vbNullString, strExecName)
GetExecutableForFile = Left$(strExecName, InStr(strExecName, Chr$(0)) - 1)
End Function
Sub RunIt(strNewFullPath As String)
Dim exeName As String
exeName = GetExecutableForFile(strNewFullPath)
Shell exeName & " " & Chr(34) & strNewFullPath & Chr(34), vbNormalFocus
End Sub
The problem with your shell command is the cmd prompt don't always support using the file extension to start a program. In fact, you better off to use
Start "path to some file with .extension"
The above is quite much the same as clicking.
However, what you really want to do is launch the msacces.exe and SUPPLY the path name to the file for it to open. This is especially the case with a runtime install.
So your code should look like this:
Sub testjump()
' jumps to a mde file called "upgrade.mde"
' it exists in the same directly as the currently running program
Dim strShellProg As String
Dim strCurrentDir As String
Const q As String = """"
strCurrentDir = CurrentProject.path & "\"
' path to msaccess is required here
strShellProg = q & SysCmd(acSysCmdAccessDir) & "msaccess.exe" & q
strShellProg = strShellProg & " " & q & strCurrentDir & "RidesUpGrade.mdE" & q
If Shell(strShellProg, vbNormalFocus) > 0 Then
' code here for shell ok
Application.Quit
Else
' code here for shell not ok
MsgBox "Un able to run Rides upgrade", vbCritical, AppName
Application.Quit
End If
End Sub
So the above uses the full path name to msaccess.exe. It been tested on xp, vista, win7 etc, and it always worked for me.
And in the case of more than one version of Access, or that of using a runtime, you may not want to use the extension to launch the file. So this ensures that you are using the SAME version and same .exe that you are currently running. So the above code pulls the current msaccess.exe path you are using, not one based on file extension.
I use this function when working in Access 2003:
Public Function RunExternalMDB(MDBName As String, WG As String, UsrNm As String, Pwd As String)
Shell "MsAccess.exe " & """" & MDBName & """" & " /wrkgrp " & """" & WG & """" & " /user " & UsrNm & " /pwd " & Pwd
End Function
This does work in Runtime mode : )
Here is a slight revision I used to make it work with accdr, where it is required that there be a runtime switch used.
strShellProg = q & SysCmd(acSysCmdAccessDir) & "msaccess.exe" & q & " /runtime"
strShellProg = strShellProg & " " & q & strCurrentDir & "spfe.accdr" & q
If Shell(strShellProg, vbNormalFocus) > 0 Then
DoCmd.Hourglass False
' DoCmd.Quit
Application.Quit
Else
' code here for shell not ok
MsgBox "Unable to run upgrade", vbCritical, AppName
DoCmd.Hourglass False
Application.Quit
End If
I need to make a "static html" FAQ-like-document for internal use on a project.
I put all the items in an Access 2007 Database as records (question, answer, category) and then built a report that uses a sub-report to create a table of contents as internal links and then lists all of the questions and answers. This report is a bunch of text-areas with dynamically generated html code(apparently I don't have enough cred to post images yet so http://i115.photobucket.com/albums/n299/SinbadEV/ReportCapture.png)... I just export the report to a text file and then rename it to .html and open it in a browser.
I'm thinking there has to be a less evil way to do this.
I have now used an idea from SinbadEV and awrigley to create professionally looking HTML-reports in MS Access 2007. In my case I had to use yet another trick:
I found out, that due to some bug in MS Access it does not save the report correctly to txt format. Sometimes it drops a lot of information, even though it is displayed on the screen. I have also seen problem, mentioned here that sometimes access mixing lines. It seem to depend on several factors, e.g. whether report and a data span across pages in MS Acess report.
However I found, that exporting to *.rtf does work correctly. Therefore the approach is to craft MS Acess report, which, when saved into text file would create an HTML code (just like described by SinbadEV ), however you 1st need to save it to *rtf. After that you need to use MS Word automation to convert from *.rtf to txt file and to give it .html extention (In reality it does not take too much efforts).
Instead of MS word automation one can probably also use tool like Doxillion Document Converter to convert from rtf to text format from command line.
You can see database with this feature in the Meeting minutes, Issues, Risks, Agreements, Actions, Projects Tracking tool (http://sourceforge.net/projects/miraapt/).
There's an ExportXML method in the Application object, which can export database objects (tables,reports etc.) in XML. You'll need a XSL style sheet or a XSTL document if you want to format it for a browser:
http://msdn.microsoft.com/en-us/library/bb258194(v=office.12).aspx
I'd say this is the "canonical" way to do it. OTOH writing XSL & XSTL isn't like a fun thing to do and if you HTML generator works, then you should simply keep it like it is. (Actually, it's a nice trick IMHO).
I don't see anything inherently "evil" in what you are doing. I wrote an article for (the now defunct magazine) Smart Access that uses a similar technique for a different reason. The HTML report was a by product. Essentially, my technique allows using Access to create very extensive word documents that flow like typed text rather than looking like reports created using boxes.
You can still read the article on MSDN:
Extending Access Reports With Word and HTML
The trick was to generate HTML using a report like you are doing, then using automation, open the .html file in Word and save it as RTF.
We used the technique to create a 300 page directory for the Diocese of York. It worked flawlessly.
Just in case you want to go the VBA way: I wrote a few functions that can make it quite easy:
create queries containing the data you want to output,
then open the query and loop through all records, outputting data to text file using function rRsToXml below.
Option Compare Database
Option Explicit
Function fRsToXml(rs As Recordset, Optional ignorePrefix As String = "zz", _
Optional ignoreNulls As Boolean = False) As String
'<description> Returns an XML string with all fields of the current record,
' using field names as tags.
' Field names starting with "zz" (or other special prefix) are ignored</description>
'<parameters> rs: recordset (byRef, of course)</parameters>
'<author> Patrick Honorez - www.idevlop.com </author>
Dim f As Field, bPrefLen As Byte
Dim strResult As String
bPrefLen = Len(ignorePrefix)
For Each f In rs.Fields
If Left(f.Name, bPrefLen) <> ignorePrefix Then 'zz fields are ignored !
If (Not ignoreNulls) Or (ignoreNulls And Not IsNull(f.Value)) Then
strResult = strResult & xTag(f.Name, f.Value) & vbCrLf
End If
End If
Next f
fRsToXml = strResult
End Function
Function xTag(ByVal sTagName As String, ByVal sValue, Optional SplitLines As Boolean = False) As String
'<description> Create an xml node and returns it as a string </description>
'<parameters> <sTagName> name of the tag </sTagName>
' <sValue> string to embed </sValue>
' <SplitLine> True to include CrLf at the end of each line
' (optional - default = False) </SplitLine></parameters>
'<author> Patrick Honorez - www.idevlop.com </author>
'<note> Make sure sValue does not contains XML forbidden characters ! </note>
'<changelog>
'</changelog>
Dim strNl As String, intAmp
If SplitLines Then
strNl = vbCrLf
Else
strNl = vbNullString
End If
xTag = "<" & sTagName & ">" & strNl & _
Nz(sValue, "") & strNl & _
"</" & sTagName & ">" '& strNl
End Function
Function CleanupStr(strXmlValue) As String
'<description> Replace forbidden char. &'"<> by their Predefined General Entities </description>
'<author> Patrick Honorez - www.idevlop.com </author>
Dim sValue As String
If IsNull(strXmlValue) Then
CleanupStr = ""
Else
sValue = CStr(strXmlValue)
sValue = Replace(sValue, "&", "&") 'do ampersand first !
sValue = Replace(sValue, "'", "'")
sValue = Replace(sValue, """", """)
sValue = Replace(sValue, "<", "<")
sValue = Replace(sValue, ">", ">")
CleanupStr = sValue
End If
End Function
I used to spoof the report generator into making html documents for me but this approach has limitations. Firstly when you run the report, it generates rather ugly html and not a print ready report. There is more work after running the report to transform the report into a nice html document that can be opened in a word processor and then saved as a regular document. LibreOffice often is a better recipient of generated html documents than ms-word but occasionally LibreOffice fails to do the job (for a while it had issues with linked images). Word processors ignore css styles so don't bother with styles, direct formatting still works well, particularly for text is tables. If all the exported data is inside a html table, then use LibreOffice as LibreOffice can generate a table of contents based on h1, h2, h3 headings, whereas ms-word cannot.
These days, I just write the entire report as a procedure in a VBA standard module. I still do not use object oriented code and there is no reason to here. Reports written entirely in VBA can be far more sophisticated that what the standard ms-Access report designer can produce. Report designer reports take a lot of tinkering to get the format just right and this consumes time. For complex reports, the VBA approach is actually faster. A report written in VBA can be run every other second, so it is easy to adjust something such as the column width of a table and to rerun the report to check the output. A html report created with VBA is written out as a html file and the ms-access can issue a shell command to open the report in a web browser. If the browser is already open, the new report opens in a new tab so you can see what the previous version looked like as this version will still be open in another tab.
Write the report in a standard module (not in a form module) and call it from some button-click event on the form. The report should only need to be told what the title is, what the output filename and location are and the data scope that the report should output. The report procedure contains all other logic necessary for creating the report. Below is the calling procedure for triggering a report in one of my applications. The purpose of the calling code is to export a list of geotagged photos in a delimited text file so that I can plot the photo locations on a map. The process for exporting a html file is very similar. Some custom functions are in the code below but the structure should be recognisable.
Private Sub cmdCSV_File_Click()
Dim FolderName As String
Dim FileName As String
Dim ReportTitle As String
Dim SQL As String
Dim FixedFields As String
Dim WhereClause As String
Dim SortOrder As String
'Set destination of exported data
FolderName = InputBox("Please enter name of folder to export to", AppName, mDefaultFolder)
If mPaths.FolderExists(FolderName).Success Then
mDefaultFolder = FolderName 'holds default folder name in case it is needed again
Else
MsgBox "Can't find this folder", vbCritical, AppName
Exit Sub
End If
FileName = CheckTrailingSlash(FolderName) & "PhotoPoints.txt"
'Set Report Title
If Nz(Me.chkAllProjects, 0) Then
ReportTitle = "Photos from all Projects"
ElseIf Nz(Me.SampleID, 0) Then
ReportTitle = "Photos from Sample " & Me.SampleID
ElseIf Nz(Me.SurveyID, 0) Then
ReportTitle = "Photos from Survey " & Me.SurveyID
ElseIf Nz(Me.ProjectID, 0) Then
ReportTitle = "Photos from Project " & Me.ProjectID
Else
MsgBox "Please select a scope before pressing this button", vbExclamation, AppName
Exit Sub
End If
'Update paths to photos
If Have(Me.ProjectID) Then
WhereClause = " (PhotoPath_ProjectID = " & Me.ProjectID & ")" 'also covers sample and survey level selections
Else
WhereClause = " True" 'when all records is selected
End If
Call mPhotos.UpdatePhotoPaths(WhereClause) 'refreshes current paths
'Set fixed parts of SQL statement
FixedFields = "SELECT Photos.*, PhotoPaths.PhotoPath_Alias, PhotoPaths.CurrentPath & Photos.PhotoName AS URL, " _
& "PhotoPaths.CurrentPath & 'Thumbs\' & Photos.PhotoName as Thumb " _
& "FROM Photos INNER JOIN PhotoPaths ON Photos.PhotoPathID = PhotoPaths.PhotoPathID WHERE "
SortOrder = " ORDER BY ProjectID, SurveyID, SampleID, Photo_ID"
'set scope for export
WhereClause = "(((Photos.Latitude) Between -90 And 90) AND ((Photos.Longitude) Between -180 And 180) AND ((Photos.Latitude)<>0) AND ((Photos.Longitude)<>0)) AND " & WhereClause
SQL = FixedFields & WhereClause & SortOrder & ";"
'Export data as a delimited list
FileName = ExportCSV(FileName, SQL)
Call OpenBrowser(FileName)
End Sub
The next bit of code actually writes out the delimited text file (html just has tags instead of pipes). The vertical bar or pipe is used to separate the values rather than a comma in this case as commas may occur in the data. The code works out how many columns there are for itself and puts headings at the top.
Public Function ExportCSV(FileAddress As Variant, SQL As String) As String
If Not gDeveloping Then On Error GoTo procerr
PushStack ("mfiles.ExportCSV")
'Exports a csv file
If Nz(FileAddress, "") = "" Then
ExportCSV = "Failed"
Exit Function
End If
'Create text file:
Dim webfile As Object, w
Set webfile = CreateObject("Scripting.FileSystemObject")
Set w = webfile.CreateTextFile(FileAddress, True)
Dim D As Database, R As Recordset, NumberOfFields As Long, Out As String, i As Long
Set D = CurrentDb()
Set R = D.OpenRecordset(SQL, dbOpenSnapshot)
If R.RecordCount > 0 Then
With R
NumberOfFields = .Fields.Count - 1
'Field headings
For i = 0 To NumberOfFields
If i = 0 Then
Out = .Fields(i).Name
Else
Out = Out & "|" & .Fields(i).Name
End If
Next
w.writeline Out
'Field data
Do Until .EOF
For i = 0 To NumberOfFields
If i = 0 Then
Out = .Fields(i)
Else
Out = Out & "|" & .Fields(i)
End If
Next i
w.writeline Out
.MoveNext
Loop
End With
End If
Set R = Nothing
Set D = Nothing
ExportCSV = FileAddress
exitproc:
PopStack
Exit Function
procerr:
Call NewErrorLog(Err.Number, Err.Description, gCurrentProc, FileAddress & ", " & SQL)
Resume exitproc
End Function
Below is a snippet from the openbrowser function. The rest of the function deals with figuring out where the web browser is, as this varies with the version of windows and whether the browser is 32 or 64 bit.
'Set up preferred browser
If Right(BrowserPath, 9) = "Opera.exe" Then
FilePrefix = "file://localhost/"
ElseIf Right(BrowserPath, 11) = "Firefox.exe" Then
FilePrefix = "file:///"
Else
FilePrefix = ""
End If
'Show report
Instruction = BrowserPath & " " & FilePrefix & WebpageName
TaskSuccessID = Shell(Instruction, vbMaximizedFocus)
This example contains about 90% of the code needed to create a html report that has its scope set by the form that calls it. Hope this gets someone over the hump.