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.
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 scheduling a task from vb.net with these parameters. Generates the task correctly and executes it. This works correctly in local, but I need that task to be created on the server. Any ideas?
Using tService As New TaskService()
Dim Fecha As DateTime = DateTime.Parse(txtFDesde.Text + " " + txtHDesde.Text)
Dim tTime As New TimeTrigger()
Dim tDefinition As TaskDefinition = tService.NewTask
tDefinition.RegistrationInfo.Description = "Tarea programada para ejecutar"
tDefinition.Settings.RunOnlyIfLoggedOn = False
tTime.StartBoundary = New DateTime(Fecha.Year, Fecha.Month, Fecha.Day, Fecha.Hour, Fecha.Minute, 0)
tDefinition.Triggers.Add(tTime)
Dim url As String = "http://localhost:5000/" & Param
tDefinition.Actions.Add(New ExecAction("cmd.exe", "/c start " & url))
tService.RootFolder.RegisterTaskDefinition("Test " & Param, tDefinition)
End Using
Try the static connect method...you'll need credentials to the server....https://msdn.microsoft.com/en-us/library/windows/desktop/aa383451(v=vs.85).aspx
This is working, I just have to add the server paramters on "Connect()"
Const TriggerTypeTime = 1
Const ActionTypeExec = 0
Dim service = CreateObject("Schedule.Service")
Call service.Connect()
Dim rootFolder
rootFolder = service.GetFolder("\")
Dim taskDefinition
taskDefinition = service.NewTask(0)
Dim regInfo
regInfo = taskDefinition.RegistrationInfo
regInfo.Description = "Testing"
regInfo.Author = "Me"
Dim principal
principal = taskDefinition.Principal
' revisar
principal.LogonType = 3
Dim settings
settings = taskDefinition.Settings
settings.Enabled = True
settings.StartWhenAvailable = True
settings.Hidden = False
Dim triggers
triggers = taskDefinition.Triggers
Dim trigger
trigger = triggers.Create(TriggerTypeTime)
Dim startTime
startTime = L_TraducirParaTrigger(Fecha)
trigger.StartBoundary = startTime
trigger.Id = "TimeTriggerId"
trigger.Enabled = True
Dim Action
Action = taskDefinition.Actions.Create(ActionTypeExec)
Action.Path = "C:\Windows\System32\cmd.exe"
Dim url As String = "http://localhost:5000/" & L_IdEjecucion
Action.Arguments = "/c start " & url
'revisar último parámetro
Call rootFolder.RegisterTaskDefinition(L_Id, taskDefinition, 6, , , 3)
How would I set following into array:
Public Function opcijeMp(ByVal hwid As String)
Dim hardware As String = hwid
Dim result = New List(Of String)()
Try
ManageConnection(False, konekcija) 'Open connection'
Dim strQuery As String = "SELECT * FROM info.opcije_mp as mp inner join instalacije as i where mp.idopcije_mp =
i.opcijeMP and i.instalacije_hwid = '" + Globals.cpuid + "';"
Dim SqlCmd As New MySqlCommand(strQuery, dbCon)
Dim reader As MySqlDataReader = SqlCmd.ExecuteReader()
While reader.Read()
Globals.prodaja = reader.GetString("Prodaja")
Globals.Kalkulacije = reader.GetString("Kalkulacije")
Globals.Zaduznice = reader.GetString("Zaduznice")
Globals.Predisponacije = reader.GetString("Predisponacije")
Globals.Robno = reader.GetString("Robno")
Globals.KUF = reader.GetString("KUF")
Globals.KIF = reader.GetString("KIF")
Globals.Narudzbenice = reader.GetString("Narudzbenice")
Globals.Nalozi = reader.GetString("Nalozi")
Globals.akcijskeCijene = reader.GetString("Akcijske_cijene")
Globals.servisnaRoba = reader.GetString("Servisna_roba")
Globals.Ostalo1 = reader.GetString("Ostalo1")
Globals.Ostalo2 = reader.GetString("Ostalo2")
Globals.Ostalo3 = reader.GetString("Ostalo3")
End While
reader.Close()
'Vraća podatke u Listi stringova
'Return result
Catch ex As MySqlException
Console.WriteLine("Error: " & ex.ToString())
Return Nothing
Finally
ManageConnection(True, konekcija)
End Try
End Function
So i can use it in next function with for each loop:
Dim s As String = Globals.prodaja
Dim parts As String() = s.Split(New Char() {","c})
Dim icona As String = parts(1)
Dim barmanager1 As New BarManager
Dim TileBarItem = New TileBarItem()
TileBarItem.Content = parts(3)
TileBarItem.Name = "ffss"
TileBarItem.Width = 150
Icon = New BitmapImage(New Uri("pack://application:,,,/DevExpress.Images.v16.1;component/Images/" + icona + ""))
TileBarItem.TileGlyph = Icon
TileBarItem.Background = New SolidColorBrush(DirectCast(ColorConverter.ConvertFromString(parts(2)), Color))
MessageBox.Show(parts(2))
maloprodaja.Items.Add(TileBarItem)
Right now i have to run function for each variable i have stored in global variables class, i would like to add all the results from first function to one array in Globals and then run second function with for each loop to populate my tilebar
Using an external variable like Globals to pass data around is extremely poor practice. Your first function in the question should return the data, or alternatively it should return the MySqlDataReader. That will simplify what you're trying to do later on and effectively make this problem go away.
I also so saw this:
Dim strQuery As String = "SELECT * FROM info.opcije_mp as mp inner join instalacije as i where mp.idopcije_mp =
i.opcijeMP and i.instalacije_hwid = '" + Globals.cpuid + "';"
I want to highlight this part:
" ... and i.instalacije_hwid = '" + Globals.cpuid + "';"
It's hard to understand just how bad that is. I can't think of a better way to get a program hacked. Google for parameterized queries and learn how to use them, rather than string concatentation, to put your cpuid into the sql statement.
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.