I'm writing a VBA code to add files, which are into several folders, into a ZIP file.
This procedure should run automatically, by a scheduled job, and I try to add a parameter to force "yes to all".
In Microsoft support there are some constants but if I add to my code, I don't have the aspected result.
the code is the following
Public Sub ZipFolder(ZipFileName As Variant, _
FolderPath As Variant, _
Optional ByVal FileFilter As String, _
Optional ByVal Overwrite As Boolean = False)
Dim fso As Object, tf As Object
Dim strZIPHeader As String, sFile As String
On Error GoTo done
' create zip file header
strZIPHeader = Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, Chr(0))
With CreateObject("Shell.Application")
sFile = Dir(FolderPath, vbNormal)
Do Until sFile = vbNullString
.Namespace(ZipFileName).CopyHere FolderPath & sFile, **"&H10&"**
sFile = Dir
Loop
End With
Set fso = Nothing
Set tf = Nothing
done:
If Err.Number <> 0 Then MsgBox Err.Description, vbApplicationModal + vbInformation
End Sub
The parameter &H10& doesn't work. I have tried with "&0X14&" as well but same result.
Any idea?
Thank you
You can study the article and full code here on exactly this subject:
Zip and unzip files and folders with VBA the Windows Explorer way
You'll see, that shall the file be overwritten, it is simply deleted before proceeding:
If FileSystemObject.FileExists(ZipFile) Then
If Overwrite = True Then
' Delete an existing file.
FileSystemObject.DeleteFile ZipFile, True
' At this point either the file is deleted or an error is raised.
Else
ZipBase = FileSystemObject.GetBaseName(ZipFile)
' Modify name of the zip file to be created to preserve an existing file:
' "Example.zip" -> "Example (2).zip", etc.
Version = Version + 1
Do
Version = Version + 1
ZipFile = FileSystemObject.BuildPath(ZipPath, ZipBase & Format(Version, " \(0\)") & ZipExtension)
Loop Until FileSystemObject.FileExists(ZipFile) = False Or Version > MaxZipVersion
If Version > MaxZipVersion Then
' Give up.
Err.Raise ErrorPathFile, "Zip Create", "File could not be created."
End If
End If
End If
Can anyone give me the code to create a backup/copy of the Database when opening? it I know how to use autoexec macro i just need the code. The database name is Datenbank and the back to have the time of back in its name
That command could be:
FileCopy CurrentDb.Name, Replace(CurrentDb.Name, ".accdb", Format(Now(), " yyyymmdd hhnnss") & ".accdb")
but you can't do that for the database file itself from inside the application.
Your best option would be to create a shortcut that runs a script that copies the file first, then opens it.
Addendum
I located a function that will create a zipped backup of the current project:
Option Compare Database
Option Explicit
' API call for sleep function.
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Function ZipCurrentProject() As Long
Dim ShellApplication As Object
Dim CurrentProjectFile As String
Dim ZipPath As String
Dim ZipName As String
Dim ZipFile As String
Dim FileNumber As Integer
' File and folder names.
CurrentProjectFile = CurrentProject.Path & "\" & CurrentProject.Name
' The path must exist.
ZipPath = CurrentProject.Path & "\#dbase_bk" & Format(Now, " yyyy-mm-dd hh.nn.ss") & "\"
ZipName = "CCOLearningHub.zip"
ZipFile = ZipPath & ZipName
' Create sub folder if missing.
If Dir(ZipPath, vbDirectory) = "" Then
MkDir ZipPath
End If
' Create empty zip folder.
FileNumber = FreeFile
Open ZipFile For Output As #FileNumber
Print #FileNumber, Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, vbNullChar)
Close #FileNumber
Set ShellApplication = CreateObject("Shell.Application")
' Copy the project file into the zip file.
With ShellApplication
Debug.Print Timer, "zipping started ..."
.Namespace(CVar(ZipFile)).CopyHere CVar(CurrentProjectFile)
' Ignore error while looking up the zipped file before is has been added.
On Error Resume Next
' Wait for the file to created.
Do Until .Namespace(CVar(ZipFile)).Items.Count = 1
' Wait a little ...
'DoEvents
Sleep 100
Debug.Print " .";
Loop
Debug.Print
' Resume normal error handling.
On Error GoTo 0
Debug.Print Timer, "zipping finished."
End With
Set ShellApplication = Nothing
ZipCurrentProject = Err.Number
End Function
I intended to write a VBA function which would copy a .mdb file if a certain criterion is met.
I hit a roadblock when I realized the FileCopy method throws an error if the .mdb it is trying to copy/paste has an associated .ldb file.
However, I am able to manually copy/paste the .mdb through windows explorer.
The .mdb i am trying to copy will always be locked, since I have added a reference to it in the DB that is running the filecopy procedure.
Can someone show me how to force a copy programatically with VBA? I tried searching but all I found was advice against doing this because of DB corruption etc. BUT this won't be an issue, because none of the DB objects will be manipulated while this procedure is executing.
If anyone is curious, here is my procedure:
Function fn_ArchiveMonthEndDB()
'load INI data
fn_ReadINI
Dim asOfDate As Date
asOfDate = getAsOfDate()
Dim monthEndDate As Date
monthEndDate = fn_GetMonthEndDate()
sSQL = "SELECT CDate(Nz(LastRunDate,'1/1/1990')) as BackupDate FROM tbl_UseStats WHERE ProcessName = 'Archive Backend DB'"
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset(sSQL)
Dim dLastBackup As Date
dLastBackup = rs!BackupDate
rs.Close
Set rs = Nothing
If (dLastBackup <> monthEndDate) Then
'determine if it actually is month-end. if yes, then archive the DB.
If (asOfDate = monthEndDate) Then
'archive backend DB
sDir = iBackendArchive & "\" & CStr(Year(monthEndDate)) & CStr(Month(monthEndDate))
'create dir if it does not exist
If (Dir(sDir, vbDirectory)) = "" Then
MkDir sDir
End If
FileCopy iBackendPath & "\ETL_be.mdb", sDir & "\ETL_be.mdb"
Else
'if no, do nothing
End If
ElseIf (dLastBackup = monthEndDate) Then
'do nothing, because we already took a backup of the backend DB.
End If
End Function
Microsoft explains it pretty simply in their KB article.
- Create a module and type the following lines in the Declarations section:
Option Explicit
Declare Function apiCopyFile Lib "kernel32" Alias "CopyFileA" _
(ByVal lpExistingFileName As String, _
ByVal lpNewFileName As String, _
ByVal bFailIfExists As Long) As Long
- Type the following procedure:
Sub CopyFile(SourceFile As String, DestFile As String)
'---------------------------------------------------------------
' PURPOSE: Copy a file on disk from one location to another.
' ACCEPTS: The name of the source file and destination file.
' RETURNS: Nothing
'---------------------------------------------------------------
Dim Result As Long
If Dir(SourceFile) = "" Then
MsgBox Chr(34) & SourceFile & Chr(34) & _
" is not valid file name."
Else
Result = apiCopyFile(SourceFile, DestFile, False)
End If
End Sub
- To test this procedure, type the following line in the Immediate window, and then press ENTER:
CopyFile "<path to Northwind.mdb>", "C:\Northwind.mdb"
I want to click a button on my access form that opens a folder in Windows Explorer.
Is there any way to do this in VBA?
You can use the following code to open a file location from vba.
Dim Foldername As String
Foldername = "\\server\Instructions\"
Shell "C:\WINDOWS\explorer.exe """ & Foldername & "", vbNormalFocus
You can use this code for both windows shares and local drives.
VbNormalFocus can be swapper for VbMaximizedFocus if you want a maximized view.
The easiest way is
Application.FollowHyperlink [path]
Which only takes one line!
Thanks to PhilHibbs comment (on VBwhatnow's answer) I was finally able to find a solution that both reuses existing windows and avoids flashing a CMD-window at the user:
Dim path As String
path = CurrentProject.path & "\"
Shell "cmd /C start """" /max """ & path & """", vbHide
where 'path' is the folder you want to open.
(In this example I open the folder where the current workbook is saved.)
Pros:
Avoids opening new explorer instances (only sets focus if window exists).
The cmd-window is never visible thanks to vbHide.
Relatively simple (does not need to reference win32 libraries).
Cons:
Window maximization (or minimization) is mandatory.
Explanation:
At first I tried using only vbHide. This works nicely... unless there is already such a folder opened, in which case the existing folder window becomes hidden and disappears! You now have a ghost window floating around in memory and any subsequent attempt to open the folder after that will reuse the hidden window - seemingly having no effect.
In other words when the 'start'-command finds an existing window the specified vbAppWinStyle gets applied to both the CMD-window and the reused explorer window. (So luckily we can use this to un-hide our ghost-window by calling the same command again with a different vbAppWinStyle argument.)
However by specifying the /max or /min flag when calling 'start' it prevents the vbAppWinStyle set on the CMD window from being applied recursively. (Or overrides it? I don't know what the technical details are and I'm curious to know exactly what the chain of events is here.)
Here is some more cool knowledge to go with this:
I had a situation where I needed to be able to find folders based on a bit of criteria in the record and then open the folder(s) that were found. While doing work on finding a solution I created a small database that asks for a search starting folder gives a place for 4 pieces of criteria and then allows the user to do criteria matching that opens the 4 (or more) possible folders that match the entered criteria.
Here is the whole code on the form:
Option Compare Database
Option Explicit
Private Sub cmdChooseFolder_Click()
Dim inputFileDialog As FileDialog
Dim folderChosenPath As Variant
If MsgBox("Clear List?", vbYesNo, "Clear List") = vbYes Then DoCmd.RunSQL "DELETE * FROM tblFileList"
Me.sfrmFolderList.Requery
Set inputFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
With inputFileDialog
.Title = "Select Folder to Start with"
.AllowMultiSelect = False
If .Show = False Then Exit Sub
folderChosenPath = .SelectedItems(1)
End With
Me.txtStartPath = folderChosenPath
Call subListFolders(Me.txtStartPath, 1)
End Sub
Private Sub cmdFindFolderPiece_Click()
Dim strCriteria As String
Dim varCriteria As Variant
Dim varIndex As Variant
Dim intIndex As Integer
varCriteria = Array(Nz(Me.txtSerial, "Null"), Nz(Me.txtCustomerOrder, "Null"), Nz(Me.txtAXProject, "Null"), Nz(Me.txtWorkOrder, "Null"))
intIndex = 0
For Each varIndex In varCriteria
strCriteria = varCriteria(intIndex)
If strCriteria <> "Null" Then
Call fnFindFoldersWithCriteria(TrailingSlash(Me.txtStartPath), strCriteria, 1)
End If
intIndex = intIndex + 1
Next varIndex
Set varIndex = Nothing
Set varCriteria = Nothing
strCriteria = ""
End Sub
Private Function fnFindFoldersWithCriteria(ByVal strStartPath As String, ByVal strCriteria As String, intCounter As Integer)
Dim fso As New FileSystemObject
Dim fldrStartFolder As Folder
Dim subfldrInStart As Folder
Dim subfldrInSubFolder As Folder
Dim subfldrInSubSubFolder As String
Dim strActionLog As String
Set fldrStartFolder = fso.GetFolder(strStartPath)
' Debug.Print "Criteria: " & Replace(strCriteria, " ", "", 1, , vbTextCompare) & " and Folder Name is " & Replace(fldrStartFolder.Name, " ", "", 1, , vbTextCompare) & " and Path is: " & fldrStartFolder.Path
If fnCompareCriteriaWithFolderName(fldrStartFolder.Name, strCriteria) Then
' Debug.Print "Found and Opening: " & fldrStartFolder.Name & "Because of: " & strCriteria
Shell "EXPLORER.EXE" & " " & Chr(34) & fldrStartFolder.Path & Chr(34), vbNormalFocus
Else
For Each subfldrInStart In fldrStartFolder.SubFolders
intCounter = intCounter + 1
Debug.Print "Criteria: " & Replace(strCriteria, " ", "", 1, , vbTextCompare) & " and Folder Name is " & Replace(subfldrInStart.Name, " ", "", 1, , vbTextCompare) & " and Path is: " & fldrStartFolder.Path
If fnCompareCriteriaWithFolderName(subfldrInStart.Name, strCriteria) Then
' Debug.Print "Found and Opening: " & subfldrInStart.Name & "Because of: " & strCriteria
Shell "EXPLORER.EXE" & " " & Chr(34) & subfldrInStart.Path & Chr(34), vbNormalFocus
Else
Call fnFindFoldersWithCriteria(subfldrInStart, strCriteria, intCounter)
End If
Me.txtProcessed = intCounter
Me.txtProcessed.Requery
Next
End If
Set fldrStartFolder = Nothing
Set subfldrInStart = Nothing
Set subfldrInSubFolder = Nothing
Set fso = Nothing
End Function
Private Function fnCompareCriteriaWithFolderName(strFolderName As String, strCriteria As String) As Boolean
fnCompareCriteriaWithFolderName = False
fnCompareCriteriaWithFolderName = InStr(1, Replace(strFolderName, " ", "", 1, , vbTextCompare), Replace(strCriteria, " ", "", 1, , vbTextCompare), vbTextCompare) > 0
End Function
Private Sub subListFolders(ByVal strFolders As String, intCounter As Integer)
Dim dbs As Database
Dim fso As New FileSystemObject
Dim fldFolders As Folder
Dim fldr As Folder
Dim subfldr As Folder
Dim sfldFolders As String
Dim strSQL As String
Set fldFolders = fso.GetFolder(TrailingSlash(strFolders))
Set dbs = CurrentDb
strSQL = "INSERT INTO tblFileList (FilePath, FileName, FolderSize) VALUES (" & Chr(34) & fldFolders.Path & Chr(34) & ", " & Chr(34) & fldFolders.Name & Chr(34) & ", '" & fldFolders.Size & "')"
dbs.Execute strSQL
For Each fldr In fldFolders.SubFolders
intCounter = intCounter + 1
strSQL = "INSERT INTO tblFileList (FilePath, FileName, FolderSize) VALUES (" & Chr(34) & fldr.Path & Chr(34) & ", " & Chr(34) & fldr.Name & Chr(34) & ", '" & fldr.Size & "')"
dbs.Execute strSQL
For Each subfldr In fldr.SubFolders
intCounter = intCounter + 1
sfldFolders = subfldr.Path
Call subListFolders(sfldFolders, intCounter)
Me.sfrmFolderList.Requery
Next
Me.txtListed = intCounter
Me.txtListed.Requery
Next
Set fldFolders = Nothing
Set fldr = Nothing
Set subfldr = Nothing
Set dbs = Nothing
End Sub
Private Function TrailingSlash(varIn As Variant) As String
If Len(varIn) > 0& Then
If Right(varIn, 1&) = "\" Then
TrailingSlash = varIn
Else
TrailingSlash = varIn & "\"
End If
End If
End Function
The form has a subform based on the table, the form has 4 text boxes for the criteria, 2 buttons leading to the click procedures and 1 other text box to store the string for the start folder. There are 2 text boxes that are used to show the number of folders listed and the number processed when searching them for the criteria.
If I had the Rep I would post a picture... :/
I have some other things I wanted to add to this code but haven't had the chance yet. I want to have a way to store the ones that worked in another table or get the user to mark them as good to store.
I can not claim full credit for all the code, I cobbled some of it together from stuff I found all around, even in other posts on stackoverflow.
I really like the idea of posting questions here and then answering them yourself because as the linked article says, it makes it easy to find the answer for later reference.
When I finish the other parts I want to add I will post the code for that too. :)
You can use command prompt to open explorer with path.
here example with batch or command prompt:
start "" explorer.exe (path)
so In VBA ms.access you can write with:
Dim Path
Path="C:\Example"
shell "cmd /c start """" explorer.exe " & Path ,vbHide
Here is what I did.
Dim strPath As String
strPath = "\\server\Instructions\"
Shell "cmd.exe /c start """" """ & strPath & """", vbNormalFocus
Pros:
Avoids opening new explorer instances (only sets focus if window
exists).
Relatively simple (does not need to reference win32 libraries).
Window maximization (or minimization) is not mandatory. Window will open with normal size.
Cons:
The cmd-window is visible for a short time.
This consistently opens a window to the folder if there is none open and switches to the open window if there is one open to that folder.
Thanks to PhilHibbs and AnorZaken for the basis for this. PhilHibbs comment didn't quite work for me, I needed to the command string to have a pair of double quotes before the folder name. And I preferred having a command prompt window appear for a bit rather than be forced to have the Explorer window maximized or minimized.
I may not use shell command because of security in the company so the best way I found on internet.
Sub OpenFileOrFolderOrWebsite()
'Shows how to open files and / or folders and / or websites / or create emails using the FollowHyperlink method
Dim strXLSFile As String, strPDFFile As String, strFolder As String, strWebsite As String
Dim strEmail As String, strSubject As String, strEmailHyperlink As String
strFolder = "C:\Test Files\"
strXLSFile = strFolder & "Test1.xls"
strPDFFile = strFolder & "Test.pdf"
strWebsite = "http://www.blalba.com/"
strEmail = "mailto:YourEmailHere#Website.com"
strSubject = "?subject=Test"
strEmailHyperlink = strEmail & strSubject
'**************FEEL FREE TO COMMENT ANY OF THESE TO TEST JUST ONE ITEM*********
'Open Folder
ActiveWorkbook.FollowHyperlink Address:=strFolder, NewWindow:=True
'Open excel workbook
ActiveWorkbook.FollowHyperlink Address:=strXLSFile, NewWindow:=True
'Open PDF file
ActiveWorkbook.FollowHyperlink Address:=strPDFFile, NewWindow:=True
'Open VBAX
ActiveWorkbook.FollowHyperlink Address:=strWebsite, NewWindow:=True
'Create New Email
ActiveWorkbook.FollowHyperlink Address:=strEmailHyperlink, NewWindow:=True
'******************************************************************************
End Sub
so actually its
strFolder = "C:\Test Files\"
and
ActiveWorkbook.FollowHyperlink Address:=strFolder, NewWindow:=True
Shell "C:\WINDOWS\explorer.exe /select,""" & ActiveWorkbook.Name & "", vbNormalFocus
Here's an answer that gives the switch-or-launch behaviour of Start, without the Command Prompt window. It does have the drawback that it can be fooled by an Explorer window that has a folder of the same name elsewhere opened. I might fix that by diving into the child windows and looking for the actual path, I need to figure out how to navigate that.
Usage (requires "Windows Script Host Object Model" in your project's References):
Dim mShell As wshShell
mDocPath = whatever_path & "\" & lastfoldername
mExplorerPath = mShell.ExpandEnvironmentStrings("%SystemRoot%") & "\Explorer.exe"
If Not SwitchToFolder(lastfoldername) Then
Shell PathName:=mExplorerPath & " """ & mDocPath & """", WindowStyle:=vbNormalFocus
End If
Module:
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
(ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function BringWindowToTop Lib "user32" _
(ByVal lngHWnd As Long) As Long
Function SwitchToFolder(pFolder As String) As Boolean
Dim hWnd As Long
Dim mRet As Long
Dim mText As String
Dim mWinClass As String
Dim mWinTitle As String
SwitchToFolder = False
hWnd = FindWindowEx(0, 0&, vbNullString, vbNullString)
While hWnd <> 0 And SwitchToFolder = False
mText = String(100, Chr(0))
mRet = GetClassName(hWnd, mText, 100)
mWinClass = Left(mText, mRet)
If mWinClass = "CabinetWClass" Then
mText = String(100, Chr(0))
mRet = GetWindowText(hWnd, mText, 100)
If mRet > 0 Then
mWinTitle = Left(mText, mRet)
If UCase(mWinTitle) = UCase(pFolder) Or _
UCase(Right(mWinTitle, Len(pFolder) + 1)) = "\" & UCase(pFolder) Then
BringWindowToTop hWnd
SwitchToFolder = True
End If
End If
End If
hWnd = FindWindowEx(0, hWnd, vbNullString, vbNullString)
Wend
End Function
Private Sub Command0_Click()
Application.FollowHyperlink "D:\1Zsnsn\SusuBarokah\20151008 Inventory.mdb"
End Sub
I just used this and it works fine:
System.Diagnostics.Process.Start("C:/Users/Admin/files");
Thanks to many of the answers above and elsewhere, this was my solution to a similar problem to the OP. The problem for me was creating a button in Word that asks the user for a network address, and pulls up the LAN resources in an Explorer window.
Untouched, the code would take you to \\10.1.1.1\Test, so edit as you see fit. I'm just a monkey on a keyboard, here, so all comments and suggestions are welcome.
Private Sub CommandButton1_Click()
Dim ipAddress As Variant
On Error GoTo ErrorHandler
ipAddress = InputBox("Please enter the IP address of the network resource:", "Explore a network resource", "\\10.1.1.1")
If ipAddress <> "" Then
ThisDocument.FollowHyperlink ipAddress & "\Test"
End If
ExitPoint:
Exit Sub
ErrorHandler:
If Err.Number = "4120" Then
GoTo ExitPoint
ElseIf Err.Number = "4198" Then
MsgBox "Destination unavailable"
GoTo ExitPoint
End If
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
Resume ExitPoint
End Sub
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