I work with Access runtime version and I need to open an encrypted database .accdb. I created a dummy file to work with getobject and opencurrentdatabase statement. I can't work with CreateObject("Access.Application") or new access.application because this is the runtime version.
My code is this, and works fine but when I open the encrypted database the UserControl property is false, and it opens whith any access message like docm.setwarnings in false and "docm.setwarnings true" doesn't work.
Option Compare Database
Dim appRT As Object
Public Sub OpenEncryptDb()
Const Q As String = """"
strPathEncryptDb = CurrentProject.Path & "\encryptdb.accdb"
strPathToDummy2 = CurrentProject.Path & "\dummy.accdb"
strPathToRuntime = SysCmd(acSysCmdAccessDir) & "msaccess.exe"
Shell Q & strPathToRuntime & Q & " /RUNTIME " & Q & strPathToDummy2 & Q, vbNormalFocus
Set appRT = GetObject(strPathToDummy2)
With appRT
.CloseCurrentDatabase
.OpenCurrentDatabase strPathEncryptDb, False, "123456" 'open encrypt database
.DoCmd.RunCommand acCmdAppMaximize
End With
End Sub
I shared the code in this link
https://1drv.ms/u/s!AsgXxStf7QGagQZIk8hcJShbCIye
open first the master.accdb file. Note that when you open the final file "encryptdb.accdb", you can delete rows and you don't receive any confirmation message that regularly you receive when you delete rows in MS-Access like "master.accdb"
Related
The following is a greatly stripped-down version of some Access 2013 code which simply makes a copy of the current project under a new name.
It works only if the file is open in shared mode. If open in exclusive mode, this generates a "Permission denied" error.
Private Sub TestCopy()
Dim sSourceFile, sSourcePath, sTargetFile, sTargetPath As String
Dim AccessObj As Object
sSourceFile = CurrentProject.Name
sSourcePath = CurrentProject.Path
sTargetFile = "TestCopy.accdb"
sTargetPath = CurrentProject.Path
Set AccessObj = CreateObject("Scripting.FileSystemObject")
AccessObj.CopyFile sSourcePath & "\" & sSourceFile, sTargetPath & "\" & sTargetFile, True
Set AccessObj = Nothing
End Sub
I'm surprised my research doesn't explain this. Is there another file copying method I can use within a database open in exclusive mode? Or do I need a method that runs outside the database?
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 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 am using CrystalReportViewer and CrystalReportSource to load and display an .rpt file in my application.
The situation I have is this:
Say a person created a Crystal Reports report outside of my application and set its datasource to database. Then I use that .rpt file in my application, but I need to bind it to a different database (identical to the original one in terms of table structure and column names but with a different connection string and user name and password).
How do I do that in VB.NET code?
Currently I load the report using:
Public Function SetReportSource(ByVal RptFile As String) As ReportDocument
Try
Dim crtableLogoninfo As New TableLogOnInfo()
Dim crConnectionInfo As New ConnectionInfo()
Dim CrTables As Tables
Dim CrTable As Table
If System.IO.File.Exists(RptFile) Then
Dim crReportDocument As New ReportDocument()
crReportDocument.Load(RptFile)
With crConnectionInfo
.ServerName = "DRIVER={MySQL ODBC 5.1 Driver};SERVER=localhost;Port=3306;UID=root;"
.DatabaseName = gDatabaseName
.UserID = gServerUser
.Password = gServerPassword
End With
CrTables = crReportDocument.Database.Tables
For Each CrTable In CrTables
CrTable.ApplyLogOnInfo(crtableLogoninfo)
CrTable.LogOnInfo.ConnectionInfo.ServerName = crConnectionInfo.ServerName
CrTable.LogOnInfo.ConnectionInfo.DatabaseName = crConnectionInfo.DatabaseName
CrTable.LogOnInfo.ConnectionInfo.UserID = crConnectionInfo.UserID
CrTable.LogOnInfo.ConnectionInfo.Password = crConnectionInfo.Password
'Apply the schema name to the table's location
CrTable.Location = gDatabaseName & "." & CrTable.Location
Next
crReportDocument.VerifyDatabase()
SetReportSource = crReportDocument
Else
MsgBox("Report file not found...", MsgBoxStyle.Critical, proTitleMsg)
End If
Catch ex As Exception
System.Windows.Forms.MessageBox.Show("Error Found..." & vbCrLf & "Error No : " & Err.Number & vbCrLf & "Description :" & Err.Description & vbCrLf & vbCrLf & "Line no : " & Err.Erl & vbCrLf & "Procedure name : SetReportSource" & vbCrLf & "Module name : GeneralFunctions", proTitleMsg)
End Try
End Function
This is how I did it. I was using Oracle with ODBC on ASP.NET, but you should be able to do the same with MySQL and ODBC:
As part of the legacy application upgrade I've been doing, I decided to move the Crystal Reports to a Web application rather that having the users access them directly on Crystal Reports XI via Citrix, which has been the method they have been using. This has several advantages, the primary one being speed. One problem that plagued me was how to change the logon information at run-time, such that the application would automatically point at the correct Oracle database (development, test, or production) based on which server the report was being accessed from.
The solution I found was to set up the Oracle Database connection as a DSN in ODBC, and connecting to the ODBC DSN rather than using the Oracle Client directly. This is not the only way to do it, but it seems to be the best way for my purposes.
In the code-behind file for the page that contains the Crystal Reports Viewer, I placed the following code that handles the same event that renders the viewer.
Protected Sub btnGenerate_Click(sender As Object, e As System.EventArgs) Handles btnGenerate.Click
Dim connInfo As New ConnectionInfo
Dim rptDoc As New ReportDocument
' setup the connection
With connInfo
.ServerName = "oracledsn" ' ODBC DSN in quotes, not Oracle server or database name
.DatabaseName = "" ' leave empty string here
.UserID = "username" ' database user ID in quotes
.Password = "password" 'database password in quotes
End With
' load the Crystal Report
rptDoc.Load(Server.MapPath(Utilities.AppSettingsFunction.getValue("ReportFolder") & ddlReports.SelectedValue))
' add required parameters
If pnlstartdates.Visible Then
rptDoc.SetParameterValue("REPORT_DATE", txtSingleDate.Text)
End If
' apply logon information
For Each tbl As CrystalDecisions.CrystalReports.Engine.Table In rptDoc.Database.Tables
Dim repTblLogonInfo As TableLogOnInfo = tbl.LogOnInfo
repTblLogonInfo.ConnectionInfo = connInfo
tbl.ApplyLogOnInfo(repTblLogonInfo)
Next
' Set, bind, and display Crystal Reports Viewer data source
Session("rptDoc") = rptDoc
Me.CrystalReportViewer1.ReportSource = Session("rptDoc")
CrystalReportViewer1.DataBind()
UpdatePanel1.Update()
End Sub
The logon info above can easily be stored in web.config instead of hard-coding it as above.
Incidentally, I chose to put my Crystal Reports Viewer in an ASP.NET AJAX Update Panel, which is why the ReportSource of the viewer is stored in a Session variable. If you choose to do this, the viewer must be databound in the Init event (not the Load event) to show up properly.
Protected Sub Page_Init(sender As Object, e As System.EventArgs) Handles Me.Init
If Not Page.IsPostBack Then
txtSingleDate.Text = Now.Date()
ElseIf Session("rptDoc") IsNot Nothing Then
Me.CrystalReportViewer1.ReportSource = Session("rptDoc")
CrystalReportViewer1.DataBind()
UpdatePanel1.Update()
End If
End Sub
I'm working on a Access database which generates some mails with mail merge called from VBA code in the Access database. The problem is that if I open a new Word document and start the mail merge (VBA), Word opens the same Access database (which is already open) to get the data. Is there any way to prevent this? So that the already opened instance of the database is used?
After some testing I get a strange behavior: If I open the Access database holding the SHIFT-Key the mail merge does not open an other Access instance of the same database. If I open the Access database without holding the key, I get the described behavior.
My mail merge VBA code:
On Error GoTo ErrorHandler
Dim word As word.Application
Dim Form As word.Document
Set word = CreateObject("Word.Application")
Set Form = word.Documents.Open("tpl.doc")
With word
word.Visible = True
With .ActiveDocument.MailMerge
.MainDocumentType = wdMailingLabels
.OpenDataSource Name:= CurrentProject.FullName, ConfirmConversions:=False, _
ReadOnly:=False, LinkToSource:=False, AddToRecentFiles:=False, _
PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", _
WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, _
SQLStatement:="[MY QUERY]", _
SQLStatement1:="", _
SubType:=wdMergeSubTypeWord2000, OpenExclusive:=False
.Destination = wdSendToNewDocument
.Execute
.MainDocumentType = wdNotAMergeDocument
End With
End With
Form.Close False
Set Form = Nothing
Set word = Nothing
Exit_Error:
Exit Sub
ErrorHandler:
word.Quit (False)
Set word = Nothing
' ...
End Sub
The whole thing is done with Access / Word 2003.
Update #1
It would also help if someone could tell me what the exact difference is between opening Access with or without the SHIFT-Key. And if it is possible to write some VBA code to enable the "features" so if the database is opened without the SHIFT-Key, it at least "simulates" it.
Cheers,
Gregor
When I do mailmerges, I usually export a .txt file from Access and then set the mail merge datasource to that. That way Access is only involved in exporting the query and then telling the Word document to do the work via automation, roughly as follows:
Public Function MailMergeLetters()
Dim pathMergeTemplate As String
Dim sql As String
Dim sqlWhere As String
Dim sqlOrderBy As String
'Get the word template from the Letters folder
pathMergeTemplate = "C:\MyApp\Resources\Letters\"
'This is a sort of "base" query that holds all the mailmerge fields
'Ie, it defines what fields will be merged.
sql = "SELECT * FROM MailMergeExportQry"
With Forms("MyContactsForm")
' Filter and order the records you want
'Very much to do for you
sqlWhere = GetWhereClause()
sqlOrderBy = GetOrderByClause()
End With
' Build the sql string you will use with this mail merge
sql = sql & sqlWhere & sqlOrderBy & ";"
'Create a temporary QueryDef to hold the query
Dim qd As DAO.QueryDef
Set qd = New DAO.QueryDef
qd.sql = sql
qd.Name = "mmexport"
CurrentDb.QueryDefs.Append qd
' Export the data using TransferText
DoCmd.TransferText _
acExportDelim, , _
"mmexport", _
pathMergeTemplate & "qryMailMerge.txt", _
True
' Clear up
CurrentDb.QueryDefs.Delete "mmexport"
qd.Close
Set qd = Nothing
'------------------------------------------------------------------------------
'End Code Block:
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'Start Code Block:
'OK. Access has built the .txt file.
'Now the Mail merge doc gets opened...
'------------------------------------------------------------------------------
Dim appWord As Object
Dim docWord As Object
Set appWord = CreateObject("Word.Application")
appWord.Application.Visible = True
' Open the template in the Resources\Letters folder:
Set docWord = appWord.Documents.Add(Template:=pathMergeTemplate & "MergeLetters.dot")
'Now I can mail merge without involving currentproject of my Access app
docWord.MailMerge.OpenDataSource Name:=pathMergeTemplate & "qryMailMerge.txt", LinkToSource:=False
Set docWord = Nothing
Set appWord = Nothing
'------------------------------------------------------------------------------
'End Code Block:
'------------------------------------------------------------------------------
Finally:
Exit Function
Hell:
MsgBox Err.Description & " " & Err.Number, vbExclamation, APPHELP
On Error Resume Next
CurrentDb.QueryDefs.Delete "mmexport"
qd.Close
Set qd = Nothing
Set docWord = Nothing
Set appWord = Nothing
Resume Finally
End Function
To use this, you need to set up your Resources\Letters subfolder and put your mailmerge template word file in there. You also need your "base" query with the field definitions in your Access App (in the example, it is called MailMergeExportQry. But you can call it anything.
You also need to figure out what filtering and sorting you will do. In the example, this is represented by
sqlWhere = GetWhereClause()
sqlOrderBy = GetOrderByClause
Once you have got your head round those things, this is highly reusable.