Access subform, how to resize columns to best fit? - ms-access

I have a form with a subform. This subform displays the results of a query that is created dynamically (user enters criteria, I build the SQL, then update the querydef and display). Problem is since the columns are dynamic the width of the columns isn't working out, some are cutting off text.
Is there a way to programmatically loop through the columns (or do the same without loop) and set them all to bestfit width after the query is refreshed?
EDIT: Here is what my code looks like now:
CurrentDb.QueryDefs("SearchResults").sql = sql
CurrentDb.QueryDefs.Refresh
Dim qdf1 As DAO.QueryDef
Dim fld1 As DAO.Field
Set qdf1 = CurrentDb.QueryDefs("SearchResults")
For i = 0 To qdf1.Fields.Count - 1
Set fld1 = qdf1.Fields(i)
fld1.CreateProperty "ColumnWidth", dbInteger
fld1.Properties("ColumnWidth") = -2 'Throws error
Set fld1 = Nothing
Next i
Me.Child20.SourceObject = "Query.SearchResults"

You can set column widths like so:
Sub SetColumnWidth()
Dim qdf1 As DAO.QueryDef
Dim fld1 As DAO.Field
Set qdf1 = CurrentDb.QueryDefs("query3")
For i = 0 To qdf1.Fields.Count - 1
Set fld1 = qdf1.Fields(i)
fld1.CreateProperty "ColumnWidth", dbInteger
'very narrow indeed
'fld1.Properties("ColumnWidth") = 200
'Or -2 : Sizes the column to fit the visible text
'but it is not quite as useful as it would seem
fld1.Properties("ColumnWidth") = -2
Set fld1 = Nothing
Next i
End Sub
See also http://support.microsoft.com/kb/210427

So I've run into this same problem just now. I was fortunate enough to have half of my queries work and the other half not. I've been using this code:
Sub QueryData(strSQL As String)
Dim qryData As DAO.QueryDef
Dim intcount As Integer
Set qryData = CurrentDb.QueryDefs("DataQuery")
qryData.SQL = strSQL
qryData.CreateProperty "ColumnWidth", dbInteger
qryData.Fields(0).Properties("ColumnWidth") = 5760
DoCmd.OpenQuery "DataQuery", , acReadOnly
End Sub
Which generated the error on half of the queries I tried to run with it. I traced it back to this odd, but simple truth: Columns built using an Alias (i.e. all formula columns and expressions) kick out this error. If the column is just a straight data pull, it works fine. If the column is, however, a formulated display.... it spits the no columwidth property error.
Hopefully this'll help someone out! I know this questions about a year old, but it was the first result Google found for me on the topic.

I was able to make this grab the open forms and autofit the selected subform within that form. If you have multiple forms/subforms you would just call the function with the new names using the lines of code at the end of the function and pasting them in your program.
Public Function AutoSizeSbCtrl(frmNameTar, sbCtrlNameTar)
For Each frm In Forms
frmName = frm.Name
If frmName = frmNameTar Then
For Each frmCtrl In frm.Controls
frmCtrlName = frmCtrl.Name
If frmCtrlName = sbCtrlNameTar Then
For Each sbfrmCtrl In frmCtrl.Controls
sbfrmCtrlName = sbfrmCtrl.Name
On Error Resume Next
sbfrmCtrl.ColumnWidth = -2
On Error GoTo 0
Next sbfrmCtrl
End If
Next frmCtrl
End If
Next frm
' paste the lines below in your code where you want it to trigger (i did on an update)
'frmNameTar= "frm12345" ' where frm12345 is the name of the form the subform is in
'sbCtrlNameTar="sbfrm67890" ' where sbfrm67890 is the name of the subform you are trying to autofit
'auSize = AutoSizeSbCtrl(frmNameTar, sbCtrlNameTar)
'end paste
End Function

Related

DLookup 3075 Missing Operator Around NZ?

This is my code:
Private Sub Form_Current()
Set rs = CurrentDb.OpenRecordset("Sites", dbOpenDynaset, dbSeeChanges)
rs.Requery
rs.MoveFirst
If Nz(Me.Site_ID.Value) > 0 Then
Me.H2OBillingIDlbl.Caption = DLookup("H2OBillingIDNum", "Sites", "H2OBillingIDNum = " & Me.txtHotelID)
Else
Me.H2OBillingIDlbl.Caption = ""
End If
End Sub
The DLookup line is throwing the error.
Me.txtHotelID box is a text entry box on the form and is used to enter numbers only.
The H2OBillingIDNum field in the recordset is Long.
I have tried putting brackets around H2OBillingIDNum; .Value at the end of H2OBillingIDNum and Me.txtHotelID alternatively and combined; entering the data as a string in which case I get data mismatch error.
I don't believe I can use a SQL query because it is a text entry field, but if I'm wrong, I'll happily take the information as I've never heard of a SQL query like that and it's a faster and more accurate method of pulling the data.
I'm out of ideas. Any suggestions? Is it the NZ? Is there a better way of writing that? Should that not be included at all? If it helps, this is a DAO db.
The error must be that Me.txtHotelID is empty, therefore your DLookup call is incomplete
DLookup("foo", "bar", "myValue = ")
gives Runtime error 3075: Syntax error (missing operator) in 'myValue = '
Here is a guide on how to debug problems like this.
Take the code apart (one command per line), and use intermediate variables. Their values can be seen in break mode by hovering the mouse on the variable name, or in the Watch window.
Recommended reading: Debugging VBA Code
If you use DLookup, there is no need at all for a recordset, so I have removed it.
Run (or step through) this code, and the error will become clear:
Private Sub Form_Current()
Dim SiteID As Long
Dim HotelID As Long
Dim strCaption As String
SiteID = Nz(Me.Site_ID.Value, 0)
If SiteID > 0 Then
' Intentionally without Nz(), will throw error
HotelID = Me.txtHotelID
' Nz() will be needed here too!
strCaption = DLookup("H2OBillingIDNum", "Sites", "H2OBillingIDNum = " & HotelID)
Else
strCaption = ""
End If
Me.H2OBillingIDlbl.Caption = strCaption
End Sub
You can reduce it to:
Private Sub Form_Current()
Dim rs As DAO.Recordset
Dim SQL As String
Dim Caption As String
If Nz(Me!Site_ID.Value, 0) > 0 Then
SQL = "Select Top 1 H2OBillingIDNum From Sites Where H2OBillingIDNum = " & Nz(Me!txtHotelID.Value, 0) & ""
Set rs = CurrentDb.OpenRecordset("SQL", dbOpenDynaset, dbSeeChanges)
Caption = rs!Fields(0).Value
End If
Me!H2OBillingIDlbl.Caption = Caption
Set rs = Nothing
End Sub
As you can see, it doesn't make much sense, as you look up H2OBillingIDNum which you already have as Me!txtHotelID.Value, so it probably should read:
SQL = "Select Top 1 SomeTextField From Sites Where H2OBillingIDNum = ...
Sorry misunderstod you
I don't really see the purpose, but one thing is sure - if your Dlookup returns a Null you get ant error. You cannot load the caption with null.
An NZ around the Dlookup is needed. But i don't know if it is possible that the Dlookup doesn't find anything

Using an Input Box to assign value to a parameter

I have the following code
command_Click()
rDate = InputBox("MM/YYYY")
end sub
When I click the command the input box appears and I input my value. But then I get another pop up asking for the parameter value for rDate.
Any thoughts?
I assume you have a query that's like
Select *
From SomeTable
Where acolumn = rDate
The rDate defined in your command_click() sub is not the same thing. That rDate is a local variable which has nothing to do with your query.
You likely want to pass your parameter to a query. Let's say your query is called vikesQuery. Your command button click code would look like this
Dim qdef As DAO.QueryDef
Set qdef = CurrentDb.QueryDefs("vikesQuery")
If qdef Is Nothing Then
Exit Sub
End If
qdef.Parameters("rDate") = InputBox("MM/YYYY") 'though there are much better ways of getting your parameter like a textbox on a form
Dim rs As DAO.Recordset
Set rs = qdef.OpenRecordset
Now your query is in a recordset where you can do lots with it. Typically you would show this on a form.
Dim frm As Form
DoCmd.OpenForm "vikesForm", acNormal
Set frm = Forms("vikesForm")
Set frm.Recordset = rs 'sets the recordset of the form to the recordset you generated from your query.
This last step assumes you have a form set up to accept the structure of this recordset. i.e. textboxes bound to the right columns.

SQL Query is updated when user updates Excel

I have an excel document that I want to link to an SQL query. In the excel document I have a list of item numbers. Whenever an item number gets changed I want the sql query to query that list of item numbers and return an output. Basically I want the excel sheet to use the Item Number as a parameter for the database item numbers ? The excel item numbers are updated daily.
Keep in mind that this is a mock example for what you are trying to do. With no knowledge of your database or spreadsheet, I can't guarantee that any of this will even work. At the very least, it will require you to make some adjustments before you can use it.
With that in mind, I have commented on various parts of the code to let you know what is going on there. The sections that have a *** are areas that you may want to change. The sections with ### are areas that you will HAVE to change for it to work for you.
This code assumes that you have a list of item numbers in column A of sheet 1, that each item number will only return one record, and that there are no blank cells in your list of item numbers.
Sub GrabItemInfo()
Dim objADO As New ADODB.Connection
Dim objRecSet As New ADODB.Recordset
Dim objCmd As New ADODB.Command
Dim strConn As String
Dim strSQL As String
Dim RowNum As Long
Dim errNum As Long
'open a connection to the database
'### change the properties for the connection to suit your needs
strConn = "DSN=DSNName; DBQ=Database; UID=Username; PWD=Password"
objADO.Open strConn
objCmd.ActiveConnection = objADO
objCmd.CommandType = adCmdText
'errNum is the row that the error log will start on
'***change errNum to change which row it starts on
errNum = 1
'***changeRowNum here to change which row to start on
RowNum = 1
'start the loop
Do Until ThisWorkbook.Sheets(1).Cells(RowNum, 1) = ""
On Error Resume Next
'### change the sql to whatever you need
'*** change the cells section if you're not using the first column
strSQL = "SELECT [field] FROM [table] WHERE ItemNum = " & ThisWorkbook.Sheets(1).Cells(RowNum, 1).Value
objCmd.CommandText = strSQL
Set objRecSet = objCmd.Execute
'pastes results from query into the cell next to the item number
'***change the cells section if you want to use a different column
ThisWorkbook.Sheets(1).Cells(RowNum, 2).CopyFromRecordset objRecSet
'clear out the recordset before the loops starts again
Set objRecSet = Nothing
'put the item number, error number, and error description on the second sheet of the work book
'***change the sheet number to put it on another sheet if you're already using the second
If Err > 0 Then
ThisWorkbook.Sheets(2).Cells(errNum, 1).Value = ThisWorkbook.Sheets(1).Cells(RowNum, 1).Value
ThisWorkbook.Sheets(2).Cells(errNum, 2).Value = Err.Number
ThisWorkbook.Sheets(2).Cells(errNum, 3).Value = Err.Description
On Error GoTo 0
End If
'raise the value for the row for the next iteration
RowNum = RowNum + 1
Loop
'clear out the connection
Set objADO = Nothing
Set objRecSet = Nothing
Set objCmd = Nothing
End Sub
For more information on connection strings, I recommend http://www.connectionstrings.com
It's a great resource to use for figuring out what kind of connection string you need. Connections strings can be...tricky...sometimes, and this really helps.
If you need any resources for SQL, I would recommend http://www.w3schools.com/sql
They have a good introduction to it there. Past that, get a good reference book, find a mentor, join forums(or Q&A sites like this one), etc. If you look into the SQL tag on this site, there is more information, along with some recommended resources as well.
Good luck.

How to properly finish an access database transaction with DAO vba?

I'm working with DAO recorsets, the basic idea is to populate one table with records many times as the given argument indicates (limit).
It appears to work, but suddenly when I want to use the form again, it throws 3022 error. When I see table values, none of them is duplicated. I delete all records from that table and refresh table and form. The table doesn't show any value until I refresh the form. The unique value that is shown is the last value i try to save in database.
Here is a little bit of code:
Private Sub add_element(loops_number As Double)
i = 1
While (i < CDbl(loops_number))
function
i = i + 1
Wend
End Sub
That is working apparently fine.
Private Sub populate()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim last As DAO.Recordset
Set db = CurrentDb()
Set rst = db.OpenRecordset("Element", dbOpenTable)
Set last = rst.Clone
With rst
.AddNew
If (last.RecordCount <= 0) Then
'here I pass input form values to recordset fields ,because its the first row
last.Close
.Update
.Close
Else
last.MoveLast
!Pk = Custom_pk 'Custom_pk is obtained with a function --- not relevant
'here I pass remain values from last record to a new one --- because records has the same attributes
last.Close
.Update
.Close
End If
Set rst = Nothing
Set ultimo = Nothing
End With
End Sub
It's like last record values stays "active" after function finish work. I don't get why this happens.
Element pk is alphanumeric e.g. : "A1", then I build a function that separates A from 1,add +1 to number and concatenate values again, so the result is "A2"
I resolved it using an Autonumber field as primary key keeping the original pk (alphanumeric) as a common field then I could mantain my vba code exactly like I wanted it.

Round Robin Records in Access VBA

I am attempting to round-robin names into a "TASK" column depending on which type of job is assigned in the "JOB" column. My table looks like this for example:
my code is as follows:
Sub macro2()
Dim Rst As DAO.Recordset
Set Rst = CurrentDb.OpenRecordset("table1")
Dim employee(2) As String
employee(0) = "empname1"
employee(1) = "empname2"
Dim i As Integer
With Rst
i = 0
Rst.MoveFirst
Do While Not .EOF
If Rst.Fields("JOB") = "LETTER" Then
Rst.Edit
Rst.Fields("Task").value = employee(i)
Rst.Update
End If
.MoveNext
i = i + 1
If i > 2 Then i = 0
Loop
End With
DoCmd.Requery
End Sub
The problem is, sometimes it "misses" an assignment, and I am not sure why.
It should have kept looping those 2 names into the column, but it wont. However, sometimes after running it a couple of times it will do it. Upon opening the DB fresh, it will not, and will appear as above after completing. Any ideas?
This piece of the code allows i to have a value of 2.
i = i + 1
If i > 2 Then i = 0
But UBound(employee) is 1, which means employee(i) should throw a "subscript out of range" error when i is 2. But you didn't report getting that error, so I don't understand what's going on.
Also your first screenshot shows "Letter" and "Change" in the Job column, but the second screenshot shows all as "Letter". That's another puzzler.
Maybe you need to load the recordset with a query rather than the full table.
Set Rst = CurrentDb.OpenRecordset("SELECT Job, Task FROM table1 " & _
"WHERE Job = 'Letter'")
Then as you move through the recordset rows, toggle i between 0 and 1.
i = IIf(i = 1, 0, 1)
It looks to me like those changes might allow your code to work as you intend. However consider an approach which is more flexible and easier to maintain. Store the employee names in a table and open a second recordset, rsEmployees, to hold those employee names. As you move through the first recordset, Rst, also advance the second: rsEmployees.MoveNext If you reach rsEmployees.EOF, do rsEmployees.MoveFirst That should "round robin" the assignments.
That approach would allow you to add/remove employees from the available pool by simply updating the employees table. You wouldn't need to revise your VBA code each time you add/remove employees.