When I update my Access application, I need to change printer settings on each PC - matching the attached labelprinters name, using a specific predefined label on each printer and then adjust the margins.
I would like to automate that process. But I'm having problems getting the reports to save the settings.
The idea is to export the printer settings to a table (done), update the application and then read the "old" settings for each report and save it as a part of the update.
Problem is, that I can't get Access 2010 to save the settings.
Any ideas?
Dim rpt As Access.Report
Dim rstUpdRptSettings As ADODB.Recordset
Dim NameOfPrinter As String
Set rstUpdRptSettings = New ADODB.Recordset
rstUpdRptSettings.Open "Select * From tblUpdRptSettings", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
Do While Not rstUpdRptSettings.EOF
DoCmd.OpenReport ReportName:=rstUpdRptSettings!ReportName, View:=acViewDesign, WindowMode:=acHidden
Set rpt = Reports(rstUpdRptSettings!ReportName)
NameOfPrinter = rstUpdRptSettings!PrinterName
With rpt
.Printer = Application.Printers(NameOfPrinter)
.Printer.TopMargin = rstUpdRptSettings!TopMargin
.Printer.BottomMargin = rstUpdRptSettings!BottomMargin
.Printer.LeftMargin = rstUpdRptSettings!LeftMargin
.Printer.RightMargin = rstUpdRptSettings!RightMargin
.Printer.PaperSize = rstUpdRptSettings!PaperSize
End With
DoCmd.Close acReport, rpt.Name, acSaveYes
rstUpdRptSettings.MoveNext
Loop
Running the code does not change any settings - nor printer name, margins or PaperSize.
Thanks for your comment.
I have solved the problem now by adding this to the code:
If .DefaultView = 0 Then
.DefaultView = 1
Else
.DefaultView = 0
End If
'Set it back
If .DefaultView = 0 Then
.DefaultView = 1
Else
.DefaultView = 0
End If
I found the explanation and code here (thanks to Daniel):
https://social.msdn.microsoft.com/Forums/sqlserver/en-US/8061fb4a-2e5f-4abe-a1ab-493c3d733e82/set-report-margins-using-vba?forum=accessdev
Answered by:
Daniel Pineault, 2010-2016 Microsoft MVP
Professional Support: http://www.cardaconsultants.com
MS Access Tips and Code Samples: http://www.devhut.net
Related
How can I get current Office Windows account email using VBA code?
I do not mean the account which the user is logged in the Windows, I mean the account that is authorized in office
See image:
I don't believe you can access it. Your best bet is linking Access to Outlook and trying to access it from there.
For example you Set a reference to the Outlook object library and then :-
Dim olook As Outlook.Application
Dim EAddress As String
Set olook = GetObject(, "Outlook.Application")
Set olook = CreateObject("Outlook.Application")
EAddress = olook.Session.CurrentUser.Address
I have a similar solution calling out to Outlook, I'm using Excel and found a way to do this, I've only ever found one address in the Accounts collection, but have a suffix match to try and catch the #company.com I'm looking for:
Dim NameSpace As Object
Dim strEmailAddress As String
Set NameSpace = CreateObject("Outlook.Application").GetNameSpace("MAPI")
strEmailAddress = ""
For Each Account In NameSpace.Accounts
If LCase(Split(Account.SMtpAddress, "#")(1)) = "contoso.com" Then
strEmailAddress = Account.SMtpAddress
Else
strEmailAddress = "Unknown"
End If
' If you want to see more values, uncomment these lines
'Debug.Print Account.DisplayName
'Debug.Print Account.UserName
'Debug.Print Account.SMtpAddress
'Debug.Print Account.AccountType
'Debug.Print Account.CurrentUser
Next
Outlook interrupts the VBA-execution (to access Outlook objects from macro) due to security.
Snap shot
Outlook Security
Hence only to get eMailID without opening object as well as handling error in case of non availability of outlook/account, following code can work in your case
VBA Code
Sub Email_Address()
Dim MAPI As Object
Status = "unknown"
On Error GoTo return_value
Set MAPI = CreateObject("Outlook.Application").GetNameSpace("MAPI")
i = 1
Do While True
Debug.Print MAPI.Accounts.Item(i)
i = i + 1
Loop
return_value:
If i > 1 Then: Status = "done..."
Debug.Print Status
End Sub
I have a problem setting the printing properties for my access reports with VBA.
I have tried to set the values using
Application.Printer.PrintQuality = acPRPQHigh
Application.Printer.PaperSize = acPRPSA5
Application.Printer.ColorMode = acPRCMColor
With
Debug.Print Application.Printer.Device
I tested if the Application.Printer is set to the right printer, which is the case.
Still, the properties are not used when the reports are printed with
DoCmd.OpenReport "Report"
May I can help you. Each Report has it`s own printer-object, so you should use
MyReport.Printer.PrintQuality = acPRPQHigh
MyReport.Printer.PaperSize = acPRPSA5
MyReport.Printer.ColorMode = acPRCMColor
or in Report_Activate:
Private Sub Report_Activate()
Set Me.Printer = Application.Printer
End Sub
I actually have 2 questions:
1. How might I see who is using my Access database?
E.g: There is someone with an Access database opened and it created the .ldb file, I would like to see a list of who opened that database (it could be more than one person).
2. How might I see who is using a linked table?
E.g: I have 10 different Access databases, and all of them are using a same linked table. I would like to see who is using that linked table.
I don't even know if it's really possible, but I really appreciate your help!
For you information: The main problem is that lots of people use the same Access in the same network drive, so when I need to change it I have to kick them all out, but I never know who is actually using it.
Update: Rather than reading and parsing the .ldb/.lacdb file, a better approach would be to use the "User Roster" feature of the Access OLEDB provider as described in the Knowledge Base article
https://support.microsoft.com/en-us/kb/285822
and in the other SO question
Get contents of laccdb file through VBA
Original answer:
I put together the following a while ago. It looked promising but then I discovered that computers are not immediately removed from the lock file when they disconnect. Instead, Jet/ACE seems to (internally) mark them as inactive: If ComputerA disconnects and then ComputerB connects, ComputerB overwrites ComputerA's entry in the lock file.
Still, it does provide a list of sorts. I'm posting it here in case somebody can offer some suggestions for refinement.
I created two tables in my back-end database:
Table: [CurrentConnections]
computerName Text(255), Primary Key
Table: [ConnectionLog]
computerName Text(255), Primary Key
userName Text(255)
A VBA Module in my back-end database contained the following code to read (a copy of) the lock file and update the [CurrentConnections] table:
Public Sub GetCurrentlyConnectedMachines()
Dim cdb As DAO.Database, rst As DAO.Recordset
Dim fso As Object '' FileSystemObject
Dim lck As Object '' ADODB.Stream
Dim lockFileSpec As String, lockFileExt As String, tempFileSpec As String
Dim buffer() As Byte
Set cdb = CurrentDb
cdb.Execute "DELETE FROM CurrentConnections", dbFailOnError
Set rst = cdb.OpenRecordset("SELECT computerName FROM CurrentConnections", dbOpenDynaset)
lockFileSpec = Application.CurrentDb.Name
If Right(lockFileSpec, 6) = ".accdb" Then
lockFileExt = ".laccdb"
Else
lockFileExt = ".ldb"
End If
lockFileSpec = Left(lockFileSpec, InStrRev(lockFileSpec, ".", -1, vbBinaryCompare) - 1) & lockFileExt
'' ADODB.Stream cannot open the lock file in-place, so copy it to %TEMP%
Set fso = CreateObject("Scripting.FileSystemObject") '' New FileSystemObject
tempFileSpec = fso.GetSpecialFolder(2) & "\" & fso.GetTempName
fso.CopyFile lockFileSpec, tempFileSpec, True
Set lck = CreateObject("ADODB.Stream") '' New ADODB.Stream
lck.Type = 1 '' adTypeBinary
lck.Open
lck.LoadFromFile tempFileSpec
Do While Not lck.EOS
buffer = lck.Read(32)
rst.AddNew
rst!computerName = DecodeSZ(buffer)
rst.Update
buffer = lck.Read(32) '' skip accessUserId, (almost) always "Admin"
Loop
lck.Close
Set lck = Nothing
rst.Close
Set rst = Nothing
Set cdb = Nothing
fso.DeleteFile tempFileSpec
Set fso = Nothing
End Sub
Private Function DecodeSZ(buf() As Byte) As String
Dim b As Variant, rt As String
rt = ""
For Each b In buf
If b = 0 Then
Exit For '' null terminates the string
End If
rt = rt & Chr(b)
Next
DecodeSZ = rt
End Function
The following code in the Main_Menu form of the front-end database updated the [ConnectionLog] table
Private Sub Form_Load()
Dim cdb As DAO.Database, rst As DAO.Recordset
Dim wshNet As Object '' WshNetwork
Set wshNet = CreateObject("Wscript.Network")
Set cdb = CurrentDb
Set rst = cdb.OpenRecordset("SELECT * FROM ConnectionLog", dbOpenDynaset)
rst.FindFirst "ComputerName=""" & wshNet.computerName & """"
If rst.NoMatch Then
rst.AddNew
rst!computerName = wshNet.computerName
Else
rst.Edit
End If
rst!userName = wshNet.userName
rst.Update
Set wshNet = Nothing
End Sub
Finally, the following form in the back-end database listed [its best guess at] the current connections
It is a "continuous forms" form whose Record Source is
SELECT CurrentConnections.computerName, ConnectionLog.userName
FROM CurrentConnections LEFT JOIN ConnectionLog
ON CurrentConnections.computerName = ConnectionLog.computerName
ORDER BY ConnectionLog.userName;
and the code-behind is simply
Private Sub Form_Load()
UpdateFormData
End Sub
Private Sub cmdRefresh_Click()
UpdateFormData
End Sub
Private Sub UpdateFormData()
GetCurrentlyConnectedMachines
Me.Requery
End Sub
Easy. Open the .ldb file in notepad (or any text editor) and you can see the machine names.
RE: How might I see who is using my Access database?
•E.g: There is someone with an Access database opened and it created the .ldb file, I would like to see a list of who opened that database (it could be more than one person).
Just happened across this while looking for something else, and I thought I might share what I do for this. Note that this assumes that the host computer (the computer on which the database file resides) uses file sharing to provide access to the file.
You will need to be on the host computer, or have authority to connect to that machine.
click Start
right-click My Computer and select Manage
if you're not on the host computer, right-click 'Computer Management' and enter the host's name
Expand 'Shared Folders' and click on 'Open Files'
At the right is the list of currently open files with the username for each current user
I agree with Gord's Original answer. I used this code on my database, it seems that there is a way around computers not being taken out of CurrentConnections upon exit of the DB.
I placed this on my main menu form because it is always open until the user exits. I used the unload event on my form to get this to work, and it works awesome! Here is my code
p.s. Ignore SetWarnings I just have that on so the user doesn't have to click through prompts.
Private Sub Form_Unload(Cancel As Integer)
Dim wshNet As Object
Dim deleteSQL As String
Set wshNet = CreateObject("WScript.Network")
DoCmd.SetWarnings False
deleteSQL = "DELETE tblCurrentConnections.* " & _
"FROM tblCurrentConnections WHERE[computerName] = '" & wshNet.computerName & "';"
DoCmd.RunSQL deleteSQL
DoCmd.SetWarnings True
End Sub
Okay, cannot find anything online about this error, so here goes.
Using Access 2003. I have a form that has a combobox dropdown. Users choose from the dropdown, and the VBA code looks at a particular table to see if data already exists. If it finds it, it displays the data associated with the record. If it does not find it, it adds a new record to the table, then tries to display the new data. The problem is that when using the following code, it does not display the new data, unless I add in Me.Requery. However, if I do that, it then gives me the above error if I try to do the same process again.
So, how can I get the data to display after adding without the above error?
Here is the relevant code...
' Find the record that matches the control.
Dim rs As DAO.Recordset
Set rs = Me.Recordset.Clone
'if no record found, then add a default record
If IsNull(Combo119) Then
Set rs = CurrentDb.OpenRecordset("SELECT * FROM [Master Reject Data]")
rs.AddNew
rs.Fields("production Date") = Date
rs.Fields("Work Order #") = Combo119.Column(0)
rs.Fields("Product Type") = ""
rs.Fields("Shift") = ""
rs.Fields("Line") = ""
rs.Fields("# Produced") = 0
rs.Fields("Reject Type") = ""
rs.Fields("Reject Quantity") = 0
rs.Fields("Reject Category") = "Rejection"
Dim tRec As Long
tRec = Combo142.ItemData(0)
rs.Fields("Report Number") = tRec
rs.Update
Me.Requery 'this is the line I added to try to get the data to appear
Set rs = Me.Recordset.Clone
rs.FindFirst "[Report Number] = " & tRec 'navigate to the newly added record
Else
rs.FindFirst "[Report Number] = " & Nz(Me![Combo119], 0) 'navigate to the record with the requested report number
End If
If Not rs.EOF Then Me.Bookmark = rs.Bookmark
Sorry, found the issue after looking at it again. The problem is that the Me.Requery statement needs to be Me.Recordset.Requery. After doing that and adding Me.Refresh, it works as intended.
To avoid requerying I think you should open the recordset specifying that it should be a dynaset
CurrentDb.OpenRecordset("SELECT * FROM [Master Reject Data]", dbOpenDynaset) - in case you want to make it a bit neater. as for the small bug, I see you've already found yourself
I have created an application form using MS Word and a whole bunch of form fields, and I have an Access db that can import all the data I need from this Word doc, thanks to this:
http://msdn.microsoft.com/en-us/library/aa155434%28office.10%29.aspx
Now everything works just fine (I even managed to get it to import into multiple tables!), but the problem with the above is that I have to manually enter the name of each file one at a time... which is fine if it's just a case of importing the application form as it comes in... but I have quite a lot sitting in a folder that needs entered into the database.
Then I found this:
How to show "Open File" Dialog in Access 2007 VBA?
I've tried to tweak and merge the two to make it work... but as you can guess, to no avail... (it doesn't help when I'm very much an Access novice!)
What I am looking to do is to be able to import a bunch of Word docs / form fields into MS Access by using the Open / Select file dialogue box... what I've got works, but I'd like to make it easier to work with!
Thanks everyone
Jake
##### Codes I been using
Option Compare Database
Option Explicit
Private Sub cmdFileDialog_Click()
' This requires a reference to the Microsoft Office 11.0 Object Library.
Dim fDialog As Office.FileDialog
Dim varFile As Variant
Dim appWord As Word.Application
Dim doc As Word.Document
' Dim cnn As New ADODB.Connection
' Dim rst As New ADODB.Recordset
Dim strDocName As String
Dim blnQuitWord As Boolean
' Clear the list box contents.
' Me.FileList.RowSource = ""
' Set up the File dialog box.
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
' Allow the user to make multiple selections in the dialog box.
.AllowMultiSelect = True
' Set the title of the dialog box.
.Title = "Select One or More Files"
' Clear out the current filters, and then add your own.
.Filters.Clear
.Filters.Add "Microsoft Word", "*.DOC"
.Filters.Add "All Files", "*.*"
' Show the dialog box. If the .Show method returns True, the
' user picked at least one file. If the .Show method returns
' False, the user clicked Cancel.
If .Show = True Then
' Loop through each file that is selected and then add it to the list box.
For Each varFile In .SelectedItems
' Me.FileList.AddItem varFile
Set appWord = GetObject(, "Word.Application")
Set doc = appWord.Documents.Open(varFile)
' cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
' "Data Source=M:\Medical\GPAppraisal\Contacts & Databases\" & _
' "AppForm.mdb;"
' rst.Open "tbl_Applicants", cnn, _
' adOpenKeyset, adLockOptimistic
' With rst
.addnew
!Title = doc.FormFields("wTitle").Result
!FirstName = doc.FormFields("wFirstName").Result
!LastName = doc.FormFields("wLastName").Result
!Address1 = doc.FormFields("wAddress1").Result
!Address2 = doc.FormFields("wAddress2").Result
!Address3 = doc.FormFields("wAddress3").Result
!City = doc.FormFields("wCity").Result
!PostCode = doc.FormFields("wPostCode").Result
!Email = doc.FormFields("wEmail").Result
!Phone1 = doc.FormFields("wPhone1").Result
!Phone2 = doc.FormFields("wPhone2").Result
!LM = doc.FormFields("wLM").Result
!LMAddress1 = doc.FormFields("wLMAddress1").Result
!LMAddress2 = doc.FormFields("wLMAddress2").Result
!LMAddress3 = doc.FormFields("wLMAddress3").Result
!LMCity = doc.FormFields("wLMCity").Result
!LMPostCode = doc.FormFields("wLMPostCode").Result
!LMEmail = doc.FormFields("wLMEmail").Result
!LMPhone = doc.FormFields("wLMPhone").Result
!LMOK = doc.FormFields("wLMOK").Result
!Probity = doc.FormFields("wProbity").Result
!Practising = doc.FormFields("wPractising").Result
!Signature = doc.FormFields("wSignature").Result
!AppDate = doc.FormFields("wAppDate").Result
!e2011012028 = doc.FormFields("w2011012028").Result
!e2011021725 = doc.FormFields("w2011021725").Result
!e2011030311 = doc.FormFields("w2011030311").Result
!e2011031625 = doc.FormFields("w2011031625").Result
!e20110203 = doc.FormFields("w20110203").Result
!e20110211 = doc.FormFields("w20110211").Result
!e20110322 = doc.FormFields("w20110322").Result
!e20110330 = doc.FormFields("w20110330").Result
.Update
.Close
End With
doc.Close
If blnQuitWord Then appWord.Quit
cnn.Close
MsgBox "Application Imported!"
Cleanup:
' Set rst = Nothing
' Set cnn = Nothing
Set doc = Nothing
Set appWord = Nothing
Next
Else
MsgBox "You clicked Cancel in the file dialog box."
End If
End With
End Sub
#
I've tried to mess with me.tables and me!forms and .add etc etc - obviously I'm a complete novice here!!!
What I want is to be able to import data from form fields in a Word Doc into a MS Access table (which I have managed to do with the first URL in my original post above); by means of selecting the Word doc from the Open/Select dialogue box, instead of manually entering the names of each Word doc.
My apologies if it sounds obvious or simple - Access is not my strong point by any means!
Before I begin I didn't understand why you have so many uncommented lines (lines beginnig mit ' ) in you code example. I assume that most of those lines would normally not bei uncommented and be part of the working code. Or are there artifacts of the Stack Overflow Editor?
I see a few problems, that might to guide you to a solution.
1) When you use
With fDialog
you let this 'open' until the end of the code (even using a second With in between). I would recommend to set you corresponding 'End With' right after you no longer require it. Remeber (or take note): The
With fDialog
[... something]
' Set the title of the dialog box.
.Title = "Select One or More Files"
is really just a shorthand for
fDialog.Title
(i.e. a "naked" . means, that it has to be appendend to the object in the With) so you could do away with the "With" entirely. IN you example I would set the "End With" right before
If .Show = True Then
and then use
If fDialog.Show = True Then
2) I would set
Set appWord = GetObject(, "Word.Application")
outside your For Each loop (don't forget to take Set appWord = Nothing outside the loop as well). Remember that with GetObject you need an runnig Word-instance, otherwise you might want to use
Set appWord = CreateObject("Word.Application")
or to have it both ways, try to get a Word-object, and if it is not available (i.e. Err.Number = 429) create a new one.
On Error Resume Next
Set appWord = GetObject(, "Word.Application")
If Err.Number = 429 Then
Set appWord = CreateObject("Word.Application")
End If
On Error GoTo 0
3) When working or at least while developping using automation I would always set
objword.Visible = True
so you see error messages or other problems right within Word.
HTH for the next steps (in case you have this problem anymore)
Andreas