Access: Shell cmd Open MDB - ms-access

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

Related

How to run .vbs through .bat file to convert .xls to .csv

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

Creating a button in Access to to open a word document

I have a word document that uses mail merge feature and gets its information from the access db. When I use this code it does not open the word document with the current information. It opens the word document with the last saved information.
If I open the word document on its own, from the task bar, it asks if I want to run the SQL and I click yes and everything operates normally. I want to click a button from within access to accomplish this same task to open the contract.
Here is the code I used:
Private Sub Command205_Click()
Dim LWordDoc As String
Dim oApp As Object
'Path to the word document
LWordDoc = "C:\Users\.....k Up\01- Proposal\contract.docx"
If Dir(LWordDoc) = "" Then
MsgBox "Document not found."
Else
'Create an instance of MS Word
Set oApp = CreateObject(Class:="Word.Application")
oApp.Visible = True
'Open the Document
oApp.Documents.Open FileName:=LWordDoc
End If
End Sub
***I should add that I am not a coder and know nothing about VBA, I copied this from this website so any help you can offer would be greatly appreciated. If you can provide me with coding or enough guidance to get me on the way would be great. Thank you
This code will run in Access to open a Mail Merge document and update content and save.
Using the link I originally posted (http://www.minnesotaithub.com/2015/11/automatic-mail-merge-with-vba-and-access/), I made a couple of modifications and was able to get that code to work.
I needed to add: ReadOnly:=True, _ to prevent a sharing violation
and I changed the Table Name of the source data.
NOTE!! You will need to change sode marked with'###' as follows:
###-1 Change to specify the full path of your TEMPLATE!!!
###-2 Change the SQLSTATEMENT to specify your recordsource!!!
Paste this code into your form, make sure you have a Command Button Click Event that executes (Either rename 'Command205' in this code, or change your control name).
Option Compare Database
Option Explicit
Private Sub Command205_Click()
Dim strWordDoc As String
'Path to the word document of the Mail Merge
'###-1 CHANGE THE FOLLOWING LINE TO POINT TO YOUR DOCUMENT!!
strWordDoc = "C:\Users\.....k Up\01- Proposal\contract.docx"
' Call the code to merge the latest info
startMerge strWordDoc
End Sub
'----------------------------------------------------
' Auto Mail Merge With VBA and Access (Early Binding)
'----------------------------------------------------
' NOTE: To use this code, you must reference
' The Microsoft Word 14.0 (or current version)
' Object Library by clicking menu Tools > References
' Check the box for:
' Microsoft Word 14.0 Object Library in Word 2010
' Microsoft Word 15.0 Object Library in Word 2013
' Click OK
'----------------------------------------------------
Function startMerge(strDocPath As String)
Dim oWord As Word.Application
Dim oWdoc As Word.Document
Dim wdInputName As String
Dim wdOutputName As String
Dim outFileName As String
' Set Template Path
wdInputName = strDocPath ' was CurrentProject.Path & "\mail_merge.docx"
' Create unique save filename with minutes and seconds to prevent overwrite
outFileName = "MailMergeFile_" & Format(Now(), "yyyymmddmms")
' Output File Path w/outFileName
wdOutputName = CurrentProject.Path & "\" & outFileName
Set oWord = New Word.Application
Set oWdoc = oWord.Documents.Open(wdInputName)
' Start mail merge
'###-2 CHANGE THE SQLSTATEMENT AS NEEDED
With oWdoc.MailMerge
.MainDocumentType = wdFormLetters
.OpenDataSource _
Name:=CurrentProject.FullName, _
ReadOnly:=True, _
AddToRecentFiles:=False, _
LinkToSource:=True, _
Connection:="QUERY mailmerge", _
SQLStatement:="SELECT * FROM [tblEmployee]" ' Change the table name or your query
.Destination = wdSendToNewDocument
.Execute Pause:=False
End With
' Hide Word During Merge
oWord.Visible = False
' Save file as PDF
' Uncomment the line below and comment out
' the line below "Save file as Word Document"
'------------------------------------------------
'oWord.ActiveDocument.SaveAs2 wdOutputName & ".pdf", 17
' Save file as Word Document
' ###-3 IF YOU DON'T WANT TO SAVE AS A NEW NAME, COMMENT OUT NEXT LINE
oWord.ActiveDocument.SaveAs2 wdOutputName & ".docx", 16
' SHOW THE DOCUMENT
oWord.Visible = True
' Close the template file
If oWord.Documents(1).FullName = strDocPath Then
oWord.Documents(1).Close savechanges:=False
ElseIf oWord.Documents(2).FullName = strDocPath Then
oWord.Documents(2).Close savechanges:=False
Else
MsgBox "Well, this should never happen! Only expected two documents to be open"
End If
' Quit Word to Save Memory
'oWord.Quit savechanges:=False
' Clean up memory
'------------------------------------------------
Set oWord = Nothing
Set oWdoc = Nothing
End Function

Use vba to refresh & renew table links

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.

Text-search in properties Access objects

Is there a way in Access to search for a certain text in object properties and so on? Just not only in the VBA source code.
I'm asking this because if I change for example the name of a field in a table I've to check a lot of object properties (Record Source, Control Source, Order By, ...). This can be done by trail-and-error or by checking all properties of each control of the forms, but that takes a lot of time.
One option is the Find and Replace tool (nice tool!), but it's a bit of overkill for me. I don't need a text replace (only 'find') and it's 37 dollar for a tool I'll only use a few times a year.
Other suggestions?
There is something I often use to find out where some function or query may be hidding somewhere unexpected (in a bound control's RowSource of within a sub-query for instance).
I use an undocumented feature to export all Access objects as raw text files.
Using a text editor that can search within files recursively under a folder(like the free Notepad++ for instance) I am then confident that I find all occurrences, however buried, of a particular string.
The Code for exporting all objects includes my IsBlank() function:
'====================================================================
' Name: DocDatabase
' Purpose: Documents the database to a series of text files
' From: http://www.datastrat.com/Code/DocDatabase.txt
' Author: Arvin Meyer
' Date: June 02, 1999
' Comment: Uses the undocumented [Application.SaveAsText] syntax
' To reload use the syntax [Application.LoadFromText]
' Modified to set a reference to DAO 8/22/2005
' Modified by Renaud Bompuis to export Queries as proper SQL
'====================================================================
Public Sub DocDatabase(Optional path As Variant = Null)
If IsBlank(path) Then
path = Application.CurrentProject.path & "\" & Application.CurrentProject.Name & " - exploded view\"
End If
On Error Resume Next
MkDir path
MkDir path & "\Forms\"
MkDir path & "\Queries\"
MkDir path & "\Queries(SQL)\"
MkDir path & "\Reports\"
MkDir path & "\Modules\"
MkDir path & "\Scripts\"
On Error GoTo Err_DocDatabase
Dim dbs As DAO.Database
Dim cnt As DAO.Container
Dim doc As DAO.Document
Dim i As Integer
Set dbs = CurrentDb() ' use CurrentDb() to refresh Collections
Set cnt = dbs.Containers("Forms")
For Each doc In cnt.Documents
Application.SaveAsText acForm, doc.Name, path & "\Forms\" & doc.Name & ".txt"
Next doc
Set cnt = dbs.Containers("Reports")
For Each doc In cnt.Documents
Application.SaveAsText acReport, doc.Name, path & "\Reports\" & doc.Name & ".txt"
Next doc
Set cnt = dbs.Containers("Scripts")
For Each doc In cnt.Documents
Application.SaveAsText acMacro, doc.Name, path & "\Scripts\" & doc.Name & ".txt"
Next doc
Set cnt = dbs.Containers("Modules")
For Each doc In cnt.Documents
Application.SaveAsText acModule, doc.Name, path & "\Modules\" & doc.Name & ".txt"
Next doc
Dim intfile As Long
Dim filename as String
For i = 0 To dbs.QueryDefs.count - 1
Application.SaveAsText acQuery, dbs.QueryDefs(i).Name, path & "\Queries\" & dbs.QueryDefs(i).Name & ".txt"
filename = path & "\Queries(SQL)\" & dbs.QueryDefs(i).Name & ".txt"
intfile = FreeFile()
Open filename For Output As #intfile
Print #intfile, dbs.QueryDefs(i).sql
Close #intfile
Next i
Set doc = Nothing
Set cnt = Nothing
Set dbs = Nothing
Exit_DocDatabase:
Debug.Print "Done."
Exit Sub
Err_DocDatabase:
Select Case Err
Case Else
MsgBox Err.Description
Resume Exit_DocDatabase
End Select
End Sub
To use it, just call DocDatabase from the Immediate window in the Access IDE, it will create a set of directories under and 'Exploded View' folder that will contain all the files.
Another option is to temporarily turn on the NAME AUTOCORRECT option. It's a badly implemented feature and can damage your database if left on for production deployment, but I very often use it when taking over an Access app created by somebody else in order convert it to use my naming conventions.
You basically turn it on, let it build the dependencies table, then make your changes. You can then walk the tree of dependencies to confirm that it got them all. When you're done, you turn it off.
However, it doesn't work for VBA code. But for changing field names and the like, it's pretty useful if used carefully.
I amended the code above to strip out temporary objects with "~" in the object name as follows:
Set cnt = dbs.Containers("Scripts")
For Each doc In cnt.Documents
If Not doc.Name Like "~*" Then
Application.SaveAsText acMacro, doc.Name, path & "\Scripts\" & doc.Name & ".txt"
End If
Next doc

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