I'm working on a heavy project which consists in migrating Microsoft Access local tables to Microsoft SQL Server, and I'm having troubles with a specific one.
I'm using the ODBC driver to MS SQL Server to link to my table IMMATRICULATION. Its column name IMMAT is a primary key. In my VBA code, I'm running this:
Dim mydb As Database
Dim myrs As Recordset
Dim req As String
Set mydb = CurrentDb()
DoCmd.Hourglass True
req = "SELECT * FROM IMMATRICULATION WHERE IMMAT ='" & Me.Liste_CANum & "'"
Set myrs = mydb.OpenRecordset(req, dbOpenDynaset, dbDenyWrite)
If myrs.RecordCount > 0 Then
IMMAT = myrs![IMMAT]
MARQUE = myrs![MARQUE]
MODELE = myrs![MODELE]
PRIX = myrs![PRIX]
DATE = myrs![DATE]
AMO_DUREE = myrs![AMO_DUREE]
AMO_MONTANT = myrs![AMO_MONTANT]
AMO_DEBUT = myrs![AMO_DEBUT]
AMO_FIN = myrs![AMO_FIN]
ASS_MONTANT = myrs![ASS_MONTANT]
SOM = myrs![SOMMEIL]
Else
myrs.AddNew
myrs![IMMAT] = Me.Liste_CANum
myrs.Update
IMMAT = Me.Liste_CANum
MARQUE = ""
MODELE = ""
PRIX = ""
DATE = ""
AMO_DUREE = ""
AMO_MONTANT = ""
AMO_DEBUT = ""
AMO_FIN = ""
ASS_MONTANT = ""
SOM = "Non"
End If
myrs.Close
mydb.Close
DoCmd.Hourglass False
but this line of code doesn't work:
Set myrs = mydb.OpenRecordset(req, dbOpenDynaset, dbDenyWrite)
And the following error message pops-up:
ODBC -- cannot lock all records
Do you have any ideas of how to solve my problem? I tried to remove the dbDenyWrite but the problem isn't solved.
Thanks
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'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...
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
I have no clue what this is. Apparently it has to be some syntax error of some sort but I can not figure out what it is for the life of me! All I am doing is save data into a table in SQL Server 2008 and I am using vba in microsoft dynamics great plains 2010. The specific line it is throwing an error is
rs("FREIGHT_RATE") = frmItemProfile.txtFreightRate
but it seems to change lines whenever I make an adjustment, so there is probably something wrong in this method somewhere. The error message only says "type mismatch" Any Help would be amazing.
Public Sub SaveRecord(strItemNumber As String)
Dim qry As String
Set rs = New ADODB.Recordset
'query table name
qry = "SELECT * FROM dbo.PCI_ITEM_PROFILE where ITEMNMBR = '" & strItemNumber & "'"
'open recordset
rs.Open qry, strDSNPCI, adOpenStatic, adLockPessimistic
If rs.EOF <> True Then
'Time to Update Record
rs("RCD_KEY") = frmItemProfile.txtRCDKey
If frmItemProfile.txtCopyRightDate = "" Then
rs("COPYRIGHT_DATE") = #1/1/1900#
Else
rs("COPYRIGHT_DATE") = frmItemProfile.txtCopyRightDate
End If
rs("FIRST_CATALOG") = frmItemProfile.txtFirstCatalog
rs("CATEGORY") = frmItemProfile.txtCategory
rs("SERIES_CD") = frmItemProfile.txtSeriesCD
rs("PARENT_CD") = frmItemProfile.txtParentCD
rs("TYPE") = frmItemProfile.txtType
rs("COMMODITY_CD") = frmItemProfile.txtCommodityCD
rs("BARCODE_1") = frmItemProfile.txtBarCodeOne
rs("BARCODE_2") = frmItemProfile.txtBarCodeTwo
rs("BARCODE_3") = frmItemProfile.txtBarCodeThree
rs("BARCODE_4") = frmItemProfile.txtBarCodeFour
rs("CLASS_GROUP") = frmItemProfile.cmbClassGroup
rs("FREIGHT_RATE") = frmItemProfile.txtFreightRate
rs("ITEM_LENGTH") = frmItemProfile.txtItemLength
rs("ITEM_WIDTH") = frmItemProfile.txtItemWidth
rs("ITEM_HEIGHT") = frmItemProfile.txtItemHeight
rs("USER2ENT") = frmItemProfile.txtUserEnt
rs("CREATE_DATE") = frmItemProfile.txtCreateDate
rs("MODIFDT") = frmItemProfile.txtModifyDate
rs("IN_KIT") = frmItemProfile.txtInKit
rs("IN_BOM") = frmItemProfile.txtInBom
rs("REP_COMM_PCT") = frmItemProfile.txtRepPct
rs("REP_COMM_EXCEPT") = frmItemProfile.txtRepCommExcept
rs("ROYALTY_ITEM") = frmItemProfile.txtRoyaltyItem
rs("PPC_PAGES") = frmItemProfile.txtPPCPages
rs("PPC_PAPER") = frmItemProfile.txtPPCPaper
rs("PPC_TONERCURVE") = frmItemProfile.txtPPCTonerCurve
rs("PPC_COIL") = frmItemProfile.txtPPCCoil
rs("PPC_IMPRESSIONS") = frmItemProfile.txtPPCImpressions
rs("DROP_SHIP_ITEM") = frmItemProfile.txtDropShipItem
rs("OP_CD") = frmItemProfile.txtOPCD
If frmItemProfile.txtOPDate = "" Then
rs("OP_DATE") = #1/1/1900#
Else
rs("OP_DATE") = frmItemProfile.txtOPDate
End If
rs("NOTES") = frmItemProfile.txtNotes
rs.Update
End If
rs.Close
Set rs = Nothing
End Sub
Here's a possible repro:
Dim rs
Set rs = CreateObject("ADODB.Recordset")
With rs
.Fields.Append "FREIGHT_RATE", adDouble, , 32 ' adFldIsNullable
.Open
.AddNew
rs("FREIGHT_RATE") = "fifty-five"
End With
The error I get:
Multiple-step operation generated errors. Check each status value.