MS ACCESS VBA module Auto number format - ms-access

I have a Repoerteq table with a REQ_NUM as ID and another column named "REQ_department".
REQ_department have defult values such as ""Finance".
I want to make VBA looks at the department and then set a prefix formate for REQ_NUM
example is department is finance then it would make id as "FIN 000"
the following code is what i manage fo far but it still not working
Option Compare Database
Function GetData() As String
Dim db As Database
Dim Rrs As DAO.Recordset
Dim RSQL As String
Dim RepData As String
Dim RepDep As String
'TO open connection to current Access DB
Set db = CurrentDb()
'TO create SQL statement and retrieve value from ReportReq table
RSQL = "select * from ReportReq"
Set Rrs = db.OpenRecordset(RSQL)
'Retrieve value if data is found
If Rrs.EOF = False Then
RepData = Rrs("REQ_NUM")
RepDep = Rrs("Req_department")
Else
RepData = "Not found"
RepDep = "Not found"
End If
Lrs.Close
Set Lrs = Nothing
GetData = RepData
If ReqDep = "finance" Then
Range("REQ_NUM") = Format$("FIN", REQ_NUM)
End If
End Function

You'll have to change your call to the Format() function which tries to format a number or date according to the format string. In addition, you're using an undefined variable REQ_NUM.
If ReqDep = "finance" Then
Range("REQ_NUM") = "FIN " & Format$("000", CLng(RepData))
' ^^^^^^ ^^^^^^^^^^^^^^^^^^^^
End If

Related

getting linked table path with tabledef.connect

I have been trying to get the path to a linked table. I am looping thru the tables. it works one the first loop but not on the 2nd loop. it returns "".
Ive tried several different ways, calling the table by name or by number. the code originally comes from Neville Turbit. Neville's code calls the table by name, but I could not get that to work.
Public Function GetLinkedDBName(TableName As String)
Dim tblTable As TableDef
Dim strReturn As String
Dim i As Integer
On Error GoTo Error_NoTable ' Handles table not found
'---------------------------------------------------------------
'
i = 0
On Error GoTo Error_GetLinkedDBName ' Normal error handling
For Each tblTable In db.TableDefs
If tblTable.Name = TableName Then
strReturn = tblTable.Connect
strReturn = db.TableDefs(i).Connect
Exit For
End If
i = i + 1
Next tblTable
You don't need a loop:
Public Function GetLinkedDBName(TableName As String) As String
Dim strReturn As String
On Error Resume Next ' Handles table not found
strReturn = CurrentDb.TableDefs(TableName).Connect
GetLinkedDBName = strReturn
End Function
This is my modification from Gustav's.
CurrentDb.TableDefs(TableName).Connect command will returns a string like this:
"MS Access;PWD=p455w0rd;DATABASE=D:\Database\MyDatabase.accdb"
The string above contains 3 information and parted by ";" char.
You need to split this information and iterate through it to get specific one which contain database path.
I am not sure if different version of ms access will return exact elements and with exact order of information in return string. So i compare the first 9 character with "DATABASE=" to get the index of array returns by Split command and get path name from it.
Public Function getLinkedDBName(TableName As String) As String
Dim infos, info, i As Integer 'infos and info declared as Variant
i = -1
On Error Resume Next ' Handles table not found
'split into infos array
infos = Split(CurrentDb.TableDefs(TableName).Connect, ";")
'iterate through infos to get index of array (i)
For Each info In infos
i = i + 1
If StrComp(Left(info, 9), "DATABASE=") = 0 Then Exit For
Next info
'get path name from array value and return the path name
getLinkedDBName = Right(infos(i), Len(infos(i)) - 9)
End Function

Set cell value with VBA

I scan and save images with Wia using VBA in Microsoft Access.
The filepath to the saved image should be set as the value of the current cell.
I can't figure out how to do this but it seems like an easy task after learning how to use Wia.
Here is my current code that scans a document.
Function scanImage() As String
Dim imagePath As String
Dim folder As String
folder = "C:\Users\username\Pictures\scans\"
Dim tempName, obj
Set obj = CreateObject("Scripting.FileSystemObject")
tempName = obj.GetTempName
Dim filename
filename = Now
filename = Replace(filename, ".", "_")
filename = Replace(filename, " ", "_")
filename = Replace(filename, ":", "_")
imagePath = folder & filename & ".jpg"
Dim dev As Device
Dim wiaDialog As New WIA.CommonDialog
Dim wiaImage As WIA.ImageFile
Set dev = wiaDialog.ShowSelectDevice
Set wiaImage = wiaDialog.ShowAcquireImage
wiaImage.SaveFile (imagePath)
scanImage = imagePath
End Function
As comments have said - there's no cells in Access, and definitely no active cell.
You can add a record to a database using either of the methods below, but how do you plan on extracting that information again?
In Excel you just ask for the data in cell A1 for example, but in a database you generally ask for the data from a field or fields where another field on that same record is equal to some other values (either by supplying the 'other value' directly or by referencing other tables within the database).
So, for example, in your database you'd ask for the file paths of all files scanned on a certain date, or have some kind of description field to identify the file.
This would be written something like:
SELECT FilePath FROM Table2 WHERE DescriptionField = 'MyPhoto'
Anyway, the answer to get that single text string (imagepath) into a new record in a table is:
Sub InsertValueToTable()
Dim imagepath As String
imagepath = "<file path>"
'NB: The table name is 'Table2', the field (column) within the table is called 'FilePath'.
'One way to do it:
'DoCmd.RunSQL "INSERT INTO Table2(FilePath) VALUES ('" & imagepath & "')"
'Another way to do it:
Dim rst As dao.Recordset
Set rst = CurrentDb.OpenRecordset("Table2")
With rst
.AddNew
rst!FilePath = imagepath
.Update
.Close
End With
Set rst = Nothing
End Sub
Note - if you use a Text field in the database you'll be limited to 255 characters.

MS Access 2013 saved append query not updating all fields

I have a saved query, qryInsertLog which is as follows:
PARAMETERS UserIDPar Long, UnitIDPar Long, LogEntryPar LongText, FNotesPar LongText;
INSERT INTO tblLogBook ( UserID, UnitID, LogEntry, FNotes )
SELECT [UserIDPar] AS Expr1, [UnitIDPar] AS Expr2, [LogEntryPar] AS Expr3, [FNotesPar] AS Expr4;
I'm trying to run this query when a save button is clicked on an unbound form, where the parameters are gathered from the form controls. My VBA code for the save button is:
Private Sub cmdSave_Click()
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim okToSave As Boolean
If Me.cboUser.Value = 0 Or IsNull(Me.cboUser.Value) Then
MsgBox "You must choose a user. Record not saved."
okToSave = False
ElseIf Me.cboUnit.Value = 0 Or IsNull(Me.cboUnit.Value) Then
MsgBox "You must choose a unit. Record not saved."
okToSave = False
ElseIf Me.txtLogEntry.Value = "" Or IsNull(Me.txtLogEntry.Value) Then
MsgBox "You must have somtehing to log. Record not saved."
okToSave = False
Else
okToSave = True
End If
Set db = CurrentDb
Set qdf = db.QueryDefs("qryInsertLog")
qdf.Parameters("UserIDPar").Value = Me.cboUser.Value
qdf.Parameters("UnitIDPar").Value = Me.cboUnit.Value
qdf.Parameters("LogEntryPar").Value = Me.txtLogEntry.Value
qdf.Parameters("FNotesPar").Value = IIf(IsNull(Me.txtFNotes.Value), "", Me.txtFNotes.Value)
If okToSave Then
qdf.Execute
End If
qdf.Close
Set qdf = Nothing
End Sub
When this code is run, the FNotes field of the table isn't updated. The other three fields update as expected. FNotes is the only field which isn't required. I hardcoded a string for FNotes paramater like so:
qdf.Parameters("FNotesPar").Value = "why doesn't this work"
rather than using the form control value, and got the same result: that field just doesn't update. When I run this query from the Access Objects window and supply parameter values from the prompts, it works just fine. When I create form that's bound to the table, it also seems to work just fine.
I can't figure out why there's no trouble updating the LogEntry field but the FNotes field fails to update.
Add the new record via a DAO.Recordset instead of a DAO.QueryDef.
First, include this declaration ...
Dim rs As DAO.Recordset
Then use this after Set db = CurrentDb ....
Set rs = db.OpenRecordset("tblLogBook")
With rs
If okToSave Then
.AddNew
!UserID = Me.cboUser.Value
!UnitID = Me.cboUnit.Value
!LogEntry = Me.txtLogEntry.Value
!FNotes = Nz(Me.txtFNotes.Value, "")
.Update
End If
.Close
End With
Note Nz(Me.txtFNotes.Value, "") gives you the same thing as IIf(IsNull(Me.txtFNotes.Value), "", Me.txtFNotes.Value), but more concisely.

insert data to a record already saved to a table

I have a recordset that is missing one field for each record and would like to add some data from a form by looking up certain criteria. I used a select query to get data onto the form in the first place and tried to reverse the assigning of values but it doesnt work as it says Run-time error 3027 'the Database or Object is Read only.' I think this is because I ran a select query to get the information but how do I input the data to the same records. the code I used is below -
Private Sub CmdAppend_Click()
Dim dbsNorthwind As dao.Database
Dim rstAmend As dao.Recordset
Dim qdfAmend As dao.QueryDef
Dim n As Integer
Set dbsNorthwind = CurrentDb
Set qdfAmend = dbsNorthwind.QueryDefs("Get_Questions_NTL")
qdfAmend.Parameters(0) = [Forms]![TeamLeader]![ComClientNotFin]
qdfAmend.Parameters(1) = [Forms]![TeamLeader]![ComDateSelect]
Set rstAmend = qdfAmend.OpenRecordset(dbOpenDynaset)
n = 0
rstAmend.MoveFirst
Do Until rstAmend.EOF
n = n + 1
rstAmend.Fields("ManagerID") = Form.Controls("SC" & n).Value
rstAmend.MoveNext
Loop
End Sub
You'd have to use the .Edit and .Update methods of the recordset object to update records. You received the error because you are trying to assign a value to a read only property.

LotusScript - Can anyone fix my function?

I'm trying to write a validation function that checks to see if an entry being added already exists in the dataset.
But the search doesn't pick it up - i can just keep entering the same appointment into the database.
If anyone can spot why my code isn't working, i'd appreciate the help.
Thanks
Public Function checkNewLocationRecordIsUnique As Boolean
Dim s As New NotesSession
Dim w As New NotesUIWorkspace
Dim db As NotesDatabase
Dim selectView As NotesView
Dim key(0 To 4) As Variant
Dim entry As NotesViewEntry
Dim entryIsNotUniqueMsg As String
Let entryIsNotUniqueMsg = "There is already an entry for this date/time. Please modify your entry's details or cancel the existing entry to continue."
Dim thisDoc As NotesDocument
Dim uiDoc As NotesUIDocument
Set uidoc = w.CurrentDocument
Set thisDoc = uidoc.Document
'get handle to database and check we've found the database
Set db = s.CurrentDatabase
If Not db Is Nothing Then
'get handle to view to lookup field combination in
Set selectView = db.GetView("allLocationRecordsByName")
Call selectView.Refresh()
If Not selectView Is Nothing Then
'populate "key" - an array of variants - with fields to use as match criteria
key(0) = thisDoc.PersonName
key(1) = thisDoc.StartDate
key(2) = thisDoc.EndDate
key(3) = thisDoc.StartTime
key(4) = thisDoc.EndTime
Set entry = selectView.GetEntryByKey(thisDoc.key, True)
'lookup the combination in the view to see if it already exists
If entry Is Nothing Then
MsgBox "No conflicting entry found! Record added.", 0, "Notice"
'if it wasn't found then the record is unique so return true
checkNewLocationRecordIsUnique = True
Else
'else the combination was found - but lets make sure that it's not this one
'(this could happen if the user is editing an existing record)
'compare uids of both thisDoc and the doc entry that was found
If entry.document.UniversalID = thisDoc.UniversalID Then
checkNewLocationRecordIsUnique = True
MsgBox "An Entry Was Found, But It Was The Entry! Record added.", 0, "Notice"
'else it WAS found as a separate document so the function returns false
Else
MsgBox entryIsNotUniqueMsg, 0, "Error: Entry Is Not Unique"
checkNewLocationRecordIsUnique = False
End If
End If
End If
End If
End Function
thisDoc.PersonName returns an array, you probably need to use
key(0) = thisDoc.PersonName(0)
key(1) = thisDoc.StartDate(0)
key(2) = thisDoc.EndDate(0)
key(3) = thisDoc.StartTime(0)
key(4) = thisDoc.EndTime(0)
You are using five lines of code to populate a local variant array called key, but you are not actually using that array for your GetEntryByKey call.
So my guess is that you want the code to say this:
Set entry = selectView.GetEntryByKey(key, True)
instead of this:
Set entry = selectView.GetEntryByKey(thisDoc.key, True)
Is the view allLocationRecordsByName sorted on each column included in the search key?
See GetEntryByKey documentation.