I'm trying to make it so that when a user selects a person from a combobox their full details are displayed but some error-handling if statements keep giving false when the conditions should be returning true
Private Sub ComboOwnerID_Change()
Dim SelID As Integer
Dim rs As DAO.Recordset
Dim db As Database
Dim strSQL As String
Dim result As String
SelID = 0
SelID = Me.ComboOwnerID.Text
If Not (SelID = 0) Then
If Not (SelID = Null) Then
Set db = CurrentDb
strSQL = "SELECT * FROM Owners WHERE OwnerID = " + SelID
Set rs = db.OpenRecordset(strSQL)
Do While Not rs.EOF
result = ""
result = rs!Title + ". "
result = result + rs!Forname + " "
result = result + rs!Surname
rs.MoveNext
Loop
Me.lblOwnerName.Caption = result
Else
Me.lblOwnerName.Caption = "error"
End If
Else
Me.lblOwnerName.Caption = "error"
End If
End Sub
It's not even reached the SQL bit yet so i don't know if that works or not
Do not use the .text property in VBA, it is only available when the control has focus. The concatenator in VBA is & not +. Using + when one of the strings is null can return null.
If Not (SelID = Null) Then
Set db = CurrentDb
You mean:
If Not IsNull(SelID) Then
Set db = CurrentDb
Related
I have a subroutine that imports records from a store procedure (imports from a query to a temp table in access) and ever since I have been working from home, it hangs up and won't complete. I have a workaround where I set up a code-break for each record and then a break before rsTemp.Close, but this requires me to run the import instead of the end-user (It is only once a week and affects only one person who typically imports)
Set rsTemp = CurrentDb.OpenRecordset("qryValuationDef_Import", dbOpenDynaset, dbSeeChanges)
Any general tips that might help with this issue as we continue to work from home?
Thank you
Sub FillValuationTable(ReportDate As Date)
Dim rsValID As DAO.Recordset
Dim rsSnap As DAO.Recordset
Dim rsTemp As DAO.Recordset
Dim rsDemand As DAO.Recordset
Dim ValId As Variant
Dim SnapID As Variant
Dim TimeStamp As Date
DoCmd.SetWarnings False
TimeStamp = Now()
If DCount("Deal_ID", "temp_GMSImport", "Selected=-1") > 0 Then 'Ensures that there are selected items to import
'Opens all applicable tables to write valuations to
Set rsValID = CurrentDb.OpenRecordset("dbo_dvsValuationDef", dbOpenDynaset, dbSeeChanges)
Set rsSnap = CurrentDb.OpenRecordset("dbo_dvsGMSDealSnapshot", dbOpenDynaset, dbSeeChanges)
Set rsTemp = CurrentDb.OpenRecordset("qryValuationDef_Import", dbOpenDynaset, dbSeeChanges)
Set rsDemand = CurrentDb.OpenRecordset("dbo_dvsValuationDriver", dbOpenDynaset, dbSeeChanges)
rsTemp.MoveFirst
Do 'loops through all selected import items and writes them to the dvsValuationDef, dvsGMSDealSnapshot, and dvsValuationDriver table tables
With rsValID
'dvsValuationDef Additions
.AddNew
''Debug.Print rsValID
!dvsValuationDef_Descript = rsTemp("Link_Description")
''capture the description
Debug.Print !dvsValuationDef_Descript
!dvsBusinessUnit_Id = rsTemp("dvsBusinessUnit_Id")
!dvsBuySellType_Id = rsTemp("dvsBuySellType_Id")
!dvsValuationDef_Counterparty = rsTemp("Counterparty")
''Debug.Print !dvsValuationDef_Counterparty
!dvsValuationDef_DealTypePrice = rsTemp("Deal_Type_Price")
!dvsValuationDef_PipeBoardCode = rsTemp("Pipe_Board_Code")
!dvsValuationDef_ReportDate = ReportDate
!dvsRegion_Id = GetTraderRegion(DLookup("dvsTrader_Id", "dbo_dvsTrader", "dvsTrader_LastName=" & Chr(34) & rsTemp("Trader") & Chr(34)), rsTemp("Trader"), rsTemp("dvsRegion_Id"))
!dvsExecutive_Id = DLookup("dvsExecutive_Id", "lu_Region_SuperRegion_Exec", "dvsRegion_ID=" & rsTemp("dvsRegion_Id"))
!dvsDealType_Id = GetDealTypeID(rsTemp("Deal_Type_Price"))
!dvsCounterpartyType_Id = rsTemp("dvsCounterpartyType_Id")
!dvsValuationDef_HasAIPTrace = 0
!dvsValuationDef_HasRamp = 0
!dvsValuationDef_IsHidden = 0
!dvsValuationDef_HasAIPAdjust = 0
!dvsValuationDef_LastModified = TimeStamp
!dvsValuationDef_IsHidden = 0
!dvsValuationDef_TradeDate = rsTemp("Trade_Date")
.Update
.Bookmark = .LastModified
ValId = !dvsValuationDef_Id
''add to print the valuation number
Debug.Print ValId
End With
With rsSnap
'dvsGMSDealSnapshot additions
.AddNew
!dvsGMSDealSnapshot_DealID = rsTemp("Deal_Id")
!dvsValuationDef_Id = ValId
!dvsGMSDealSnapshot_Trader = rsTemp("Trader")
!dvsGMSDealSnapshot_TradeDate = rsTemp("Trade_Date")
!dvsGMSDealSnapshot_Region = rsTemp("Region")
!dvsGMSDealSnapshot_DealLink = rsTemp("Deal_Link_ID")
''Debug.Print !dvsGMSDealSnapshot_DealLink
!dvsGMSDealSnapshot_LinkDescription = rsTemp("Link_Description")
!dvsGMSDealSnapshot_BusinessUnit = rsTemp("Business_Unit")
!dvsGMSDealSnapshot_BuySell = rsTemp("Buy_Sell")
!dvsGMSDealSnapshot_Counterparty = rsTemp("Counterparty")
!dvsGMSDealSnapshot_DealTypePrice = rsTemp("Deal_Type_Price")
!dvsGMSDealSnapshot_PipeBoardCode = rsTemp("Pipe_Board_Code")
!dvsGMSDealSnapshot_IsAMA = rsTemp("AMA")
!dvsGMSDealSnapshot_IsToggle = rsTemp("Toggle")
!dvsGMSDealSnapshot_StartDate = rsTemp("Start_Date")
!dvsGMSDealSnapshot_StopDate = rsTemp("Stop_Date")
!dvsGMSDealSnapshot_Quantity = rsTemp("Quantity")
!dvsGMSDealSnapshot_TotalDemand = rsTemp("Total_Demand")
!dvsGMSDealSnapshot_LastModified = TimeStamp
.Update
.Bookmark = .LastModified
SnapID = !dvsGMSDealSnapshot_Id
''Debug.Print "snap ID" + SnapID
End With
With rsDemand
'dvsValuationDriver additions (this is Demand only)
.AddNew
!dvsValuationDriver_StartDate = rsTemp("Start_Date")
!dvsValuationDriver_StopDate = rsTemp("Stop_Date")
!dvsValuationDriver_Override = rsTemp("Total_Demand")
!dvsValuationDef_Id = ValId
!dvsGMSDealSnapshot_Id = SnapID
!dvsValuationDriverCat_Id = 3
!dvsValuationDriver_LastModified = TimeStamp
.Update
End With
'The following adds the trader to the Many to One table
DoCmd.RunSQL "INSERT INTO dbo_dvsValuationDef_dvsTrader ( dvsTrader_Id, dvsValuationDef_Id )" & _
" SELECT " & Nz(rsTemp("dvsTrader_Id"), 0) & ", " & ValId & "; "
rsTemp.MoveNext
Loop Until rsTemp.EOF 'Loop until all the selected items for import are written correctly
rsTemp.Close
rsValID.Close
rsSnap.Close
End If
SequenceRowNumbers ReportDate
DoCmd.SetWarnings True
End Sub
The best thing to do would be to re-write this as a stored procedure within SQL Server, although this may take time depending on your TSQL skills.
A second option would be to create an Access database that is on the server in question. This database would have the correct tables from SQL Server linked, and you can then run your code in that database, rather than suffering the lag that you are currently experiencing.
Regards,
I am "creating" my first loop, I copied code and am trying to get it to work. I have the loop functioning but when I try to do a Dlookup in the middle of the loop it does not work.
I am sure there are some ways to make this code work better, Just trying to retrieve dynamic data for the body of my email.
Here is the relevant part of the loop.
strSQL = "SELECT * FROM emailbody Where EmailMainID = " & Me.EmailMainID
Set rs = CurrentDb.OpenRecordset(strSQL)
With rs
If Not .BOF And Not .EOF Then
.MoveLast
.MoveFirst
While (Not .EOF)
LookupInfo = rs.Fields("beforetable") & "-" & rs.Fields("beforefield") 'Get Table and Field to lookup
LookupLen = Len(LookupInfo) 'Find how many letters are in the string
SubtractLen = InStr(1, [LookupInfo], "-") ' Find the number of letters to the left
RightCut = LookupLen - SubtractLen ' Find how many are to the right
Table = Left([LookupInfo], InStr(1, [LookupInfo], "-") - 1) ' Set the table value
Field = Right([LookupInfo], RightCut) ' Set the Field Value
InfoInsert = DLookup("Table", "Field", TeamDetailsID = 39)
FreshData = rs.Fields("emailbodyid") & " " & rs.Fields("bodycontent")
LongEmail = EmailMe & FreshData
EmailMe = LongEmail
FreshData = ""
LongEmail = ""
.MoveNext
Wend
End If
.Close
End With
it should be:
InfoInsert = DLookup("Table", "Field", "TeamDetailsID = 39")
or, if you use a variable
InfoInsert = DLookup("Table", "Field", "TeamDetailsID = " & idteam)
So I my most recent test tells me my difficulty is not the loop.
I tested the code this way (Yes I had the field and the table mixed up in the above example)
I get the result in Test2 But not Test1
Dim Table As String
Dim Field As String
Table = TeamDetails
Field = DepartDate
test2 = DLookup("DepartDate", "TeamDetails", "TeamDetailsID = 39")
MsgBox test2
test1 = DLookup("Field", "Table", "TeamDetailsID = 39")
MsgBox test1
Part of the issue is opening the table for the record set and having to set focus to the subform. I have been unsuccessful in sorting the table through vba. The goal is to find the MEDIAN value of a table, hence the sorting.
Private Sub cboUser_AfterUpdate()
Dim sourceReset As String
Dim dbMedian As DAO.Database
Dim rsMedian As DAO.Recordset
sourceReset = sbf.SourceObject '<--Is Table.TEMPtable btw.
Me.sbf.SourceObject = ""
Forms!frm.Requery
Forms!frm.Refresh
'Create new TEMPtable
DoCmd.SetWarnings False
DoCmd.OpenQuery "qryTEMPtable" '<--Is sorted here as desired
DoCmd.SetWarnings True
Set dbMedian = CurrentDb()
Set rsMedian = dbMedian.OpenRecordset("TEMPtable") '<--Gets unsorted here
sbf.SourceObject = sourceReset
Me.OrderBy = "NetWrkDays ASC" '<--Re-sorting, but on subform, which.. is
fine if I can return the column value later.
Forms!frm.Refresh
Me.[sbf].SetFocus
Records= DCount("[ColA]", "TEMPtable")
'Even number of records
If Records - 2 * Int(Records / 2) = 0 Then
MEDrcd = Records / 2
DoCmd.GoToRecord , , acGoTo, MEDrcd '<-Can see value in debug, how to
assign it to a useful variable???
''''Me.CurrentRecord ("NetWrkDays")
''''Me.RecordSource ("NetWrkDays")
Me.txtMED = rsMedian("NetWrkDays")
End If
'Odd number of records
If Records - 2 * Int(Records / 2) = 1 Then
MEDrcd1 = (Records - 1) / 2
MEDrcd2 = (Records + 1) / 2
DoCmd.GoToRecord acDataForm, "TempTable", acGoTo, MEDrcd1
MED1 = rsMedian("NetWrkDays")
DoCmd.GoToRecord acDataForm, "TempTable", acGoTo, MEDrcd2
MED2 = rsMedian("NetWrkDays")
Me.txtMED = (MED1 + MED2) / 2
End If
I guess I see no point in trying to use DoCmd.GoToRecord if you cant return the value at that point.
What is the best/correct method for returning a value after moving to a record.
As the subform and table are the same, I just ran with setting focus to the subform as I said was having issue sorting the table in vba. Though then me using rsMedian makes no sense, as the table rs never moves...but I cant retrieve a value for moving though the subform using GoToRecord.
I am going in circles here and i hope is not to garbled to understand. Thank you.
Found this method online. Is working great in case anyone else finds themselves in a similar situation.
Private Sub cboUser_AfterUpdate()
Dim sourceReset As String, sqlMED As String, sTable As String, sField As String
Dim j As Integer, varVal As Single
Dim rs As DAO.Recordset
sourceReset = sbf.SourceObject
Me.sbf.SourceObject = ""
Forms!frmSTATS.Requery
Forms!frmSTATS.Refresh
'Create new TEMPtable table
DoCmd.SetWarnings False
DoCmd.OpenQuery "qryTEMPtable"
DoCmd.SetWarnings True
'Get MEDIAN Data/Value
sTable = "TEMPtable"
sField = "NetWrkDays"
sqlMED = "SELECT " & sField & " from " & sTable & " WHERE " & sField & ">0 Order by " & sField & ";"
Set rs = CurrentDb.OpenRecordset(sqlMED)
rs.MoveLast
j = rs.RecordCount
rs.Move -Int(j / 2)
If j Mod 2 = 1 Then 'odd number of elements
getMedian = rs(sField)
Else 'even number of elements
varVal = rs(sField)
rs.MoveNext
varVal = varVal + rs(sField)
getMedian = varVal / 2
End If
Me.txtAnswer = getMedian
rs.Close
sbf.SourceObject = sourceReset
Me.OrderBy = "NetWrkDays ASC"
Forms!frmSTATS.Refresh
End Sub
I'm trying to run an event, but when I run it, I get the error:
The expression On Click you entered as the event property setting
produced the following error: The Expression you entered has a
function containing the wrong number of arguments.
The expression may not result in the name of a macro, the name of a user-defined function, or [Event Procedure].
There may have been an error evaluating the function, even, or macro.
I'd use the following code:
Public Function CH05_Generate(Sagsnr As String)
Dim WordApp As Word.Application
Dim Doc As Word.Document
Dim WordPath As String
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim sql As String
Set db = CurrentDb
sql = "SELECT * FROM Projektdata WHERE Sagsnr Like '" & Sagsnr & "'"
Set rst = db.OpenRecordset(sql, dbOpenDynaset)
WordPath = "My path (Can't show this"
Set WordApp = CreateObject("Word.Application")
Set Doc = WordApp.Documents.Add(WordPath)
With Doc
.FormFields("PName").Result = rst![Projektnavn]
.FormFields("text").Result = Forms![TD-E-PM200-CH05]!Kommentar
.FormFields("S3").Result = Forms![TD-E-PM200-CH05]!sub.Form!Q1
.FormFields("S4").Result = Forms![TD-E-PM200-CH05]!sub.Form!Q2
.FormFields("S5").Result = Forms![TD-E-PM200-CH05]!sub.Form!Q3
.FormFields("S6").Result = Forms![TD-E-PM200-CH05]!sub.Form!Q4
.FormFields("S7").Result = Forms![TD-E-PM200-CH05]!sub.Form!Q5
.FormFields("S8").Result = Forms![TD-E-PM200-CH05]!sub.Form!Q6
.FormFields("S9").Result = Forms![TD-E-PM200-CH05]!sub.Form!Q7
.FormFields("S10").Result = Forms![TD-E-PM200-CH05]!sub.Form!Q8
.FormFields("S11").Result = Forms![TD-E-PM200-CH05]!sub.Form!Q9
.FormFields("S12").Result = Forms![TD-E-PM200-CH05]!sub.Form!Q10
.FormFields("S13").Result = Forms![TD-E-PM200-CH05]!sub.Form!Q11
.FormFields("S14").Result = Forms![TD-E-PM200-CH05]!sub.Form!Q12
.FormFields("S15").CheckBox.Value = Forms![TD-E-PM200-CH05]!sub.Form!Q13
.FormFields("S16").CheckBox.Value = Forms![TD-E-PM200-CH05]!sub.Form!Q14
.FormFields("S17").CheckBox.Value = Forms![TD-E-PM200-CH05]!sub.Form!Q15
.FormFields("S18").Result = Forms![TD-E-PM200-CH05]!sub.Form!Q16
.FormFields("S19").Result = Forms![TD-E-PM200-CH05]!sub.Form!Q17
.FormFields("S20").Result = Forms![TD-E-PM200-CH05]!sub.Form!Q18
.FormFields("S21").Result = Forms![TD-E-PM200-CH05]!sub.Form!Q19
.FormFields("S22").Result = Forms![TD-E-PM200-CH05]!sub.Form!Q20
.FormFields("S23").Result = Forms![TD-E-PM200-CH05]!sub.Form!Q21
.FormFields("S24").Result = Forms![TD-E-PM200-CH05]!sub.Form!Q22
.FormFields("S25").Result = Forms![TD-E-PM200-CH05]!sub.Form!Q23
.FormFields("S26").Result = Forms![TD-E-PM200-CH05]!sub.Form!Q24
.FormFields("S27").Result = Forms![TD-E-PM200-CH05]!sub.Form!Q25
.FormFields("S28").Result = Forms![TD-E-PM200-CH05]!sub.Form!Q26
.FormFields("S29").Result = Forms![TD-E-PM200-CH05]!sub.Form!Q27
.FormFields("S30").Result = Forms![TD-E-PM200-CH05]!sub.Form!Q28
.FormFields("S31").Result = Forms![TD-E-PM200-CH05]!sub.Form!Q29
.FormFields("S32").Result = Forms![TD-E-PM200-CH05]!sub.Form!Q30
.FormFields("S33").CheckBox.Value = Forms![TD-E-PM200-CH05]!sub.Form!Q31
.FormFields("S34").CheckBox.Value = Forms![TD-E-PM200-CH05]!sub.Form!Q32
.FormFields("S35").CheckBox.Value = Forms![TD-E-PM200-CH05]!sub.Form!Q33
.FormFields("S36").CheckBox.Value = Forms![TD-E-PM200-CH05]!sub.Form!Q34
.FormFields("S37").CheckBox.Value = Forms![TD-E-PM200-CH05]!sub.Form!Q35
End With
WordApp.visible = True
WordApp.Activate
WordApp.ActiveDocument.Protect wdAllowOnlyFormFields, True
End Function
What I want to achieve to get data from the "Projektdata" database, and get the correct data, "Projektnavn", to fill out:
.FormFields("PName").Result = rst![Projektnavn]
My database structure is like this:
"SELECT *
FROM dbo.Projektdata p
JOIN dbo.Items i ON p.Sagsnr = i.Sagsnr
WHERE ItemID =" & ItemID & " AND p.Sagsnr Like '" & Sagsnr & "'" -- change "," to AND
I call my function like this: =CH05_Generate()
Public Function CH05_Generate(Sagsnr As String, ItemID As String)
This cannot work - the function expects two parameters, you need to pass them in the function call.
I have multiple records with the same customer number and I using Find next method to search for the next record with the customer number is same. my code will only search for the 2nd record and not go for the 3rd or 4th search for the same customer number. below is the code can you please help
Private Sub Command114_Click()
Dim db As dao.Database
Dim rs1 As dao.Recordset
Dim pn As Long
Set db = CurrentDb()
Set rs1 = db.OpenRecordset("Application", dbOpenDynaset)
If (Text85 & vbNullString) = vbNullString Then
MsgBox "Please enter the Account no/CIF"
Else
pn = Me.Text85.Value
rs1.FindNext "[Cus_Number] = " & pn
If rs1.NoMatch Then
MsgBox ("Sorry The Accountno/CIF is not found")
Else
Me.S_No = rs1.Fields("sno").Value
Me.Cus_Name = rs1.Fields("Cus_Name").Value
Me.App_level1 = rs1.Fields("App_level1").Value
Me.App_level2 = rs1.Fields("App_level2").Value
Me.App_level3 = rs1.Fields("App_level3").Value
Me.Dec_level1 = rs1.Fields("Dec_level1").Value
Me.Dec_level2 = rs1.Fields("Dec_level2").Value
Me.Dec_level3 = rs1.Fields("Dec_level3").Value
Me.Com_level1 = rs1.Fields("Com_level1").Value
Me.Com_level2 = rs1.Fields("Com_level2").Value
Me.Com_level3 = rs1.Fields("Com_level3").Value
Me.Date1 = rs1.Fields("Date1").Value
Me.Date2 = rs1.Fields("Date2").Value
Me.Date3 = rs1.Fields("Date3").Value
End If
End If
rs1.FindNext "[Cus_Number] = " & pn
Set rs1 = Nothing
End Sub
I am assuming the functionality you want is to change all instances (2, 3, 4 etc.) to the values entered. Remove this (the one near the end, after the End If):
rs1.FindNext "[Cus_Number] = " & pn
and put the FindNext into a loop which will keep on finding and updating your records until there is NoMatch:
rs1.FindNext "[Cus_Number] = " & pn
If rs1.NoMatch Then
MsgBox ("Sorry The Accountno/CIF is not found")
Else
Do Until rs1.NoMatch
Me.S_No = rs1.Fields("sno").Value
Me.Cus_Name = rs1.Fields("Cus_Name").Value
Me.App_level1 = rs1.Fields("App_level1").Value
Me.App_level2 = rs1.Fields("App_level2").Value
Me.App_level3 = rs1.Fields("App_level3").Value
Me.Dec_level1 = rs1.Fields("Dec_level1").Value
Me.Dec_level2 = rs1.Fields("Dec_level2").Value
Me.Dec_level3 = rs1.Fields("Dec_level3").Value
Me.Com_level1 = rs1.Fields("Com_level1").Value
Me.Com_level2 = rs1.Fields("Com_level2").Value
Me.Com_level3 = rs1.Fields("Com_level3").Value
Me.Date1 = rs1.Fields("Date1").Value
Me.Date2 = rs1.Fields("Date2").Value
Me.Date3 = rs1.Fields("Date3").Value
rs1.FindNext "[Cus_Number] = " & pn
Loop
End If
In general, though, I'm not sure what you are looking to do. Are you looking to update the recordset with the latest information on the form? The code you have will overwrite the current values on the form with the last set of found values in the recordset. I would have thought you want the opposite...