VB6 Data Reports do not match datasource using ADO Shape - vb6

I'm trying to get the datareport working since dataflexgrid is already working, although I'm having a hard time passing the values to datareport, I can't even pass one please help thanks.
PS. all of them are in one form
Set mRS = New ADODB.Recordset
mRS.CursorLocation = adUseClient
mRS.CursorType = adOpenForwardOnly
mRS.LockType = adLockReadOnly
If mRS.State = 1 Then mRS.Close
mRS.Open "SHAPE {" & _
"SELECT " & _
"space(memberstree.level*6) + customer.description, " & _
"customer.customercode, " & _
"customer.remarks, " & _
"customer.membersince " & _
"From CUSTOMER " & _
"INNER JOIN memberstree on customer.customercode = memberstree.customercode " & xRootNode & " " & _
"ORDER by memberstree.pedigree + ltrim(str(memberstree.node,6,0))} AS rsCustomer " & _
"APPEND (( SHAPE {SELECT transactionNo, logdate, customercode, GrandTotal " & _
"From FinishedTransaction where " & xCriteria & "} AS rsTransaction " & _
"APPEND ({SELECT TransactionNo, Description, Qty From FinishedSales} As rsSales " & _
"RELATE TransactionNo TO TransactionNo))" & _
" RELATE customercode TO customercode)", gCNMark
mRS.Requery
Set MSHFlexGrid1.DataSource = mRS
I think this is the code that isn't working
With rptShape
Set .DataSource = mRS
.DataMember = ""
With .Sections("FinishedSales_Detail").Controls
.Item("txtDescription").DataMember = "rsSales"
.Item("txtDescription").DataField = "Description"
End With
.Show 1

It's ok now I have 3 TABLE with 2 SHAPE Command but in the data report I have 3 Group Header and supposed to be 2 as well.

Related

Access update SQL

I am trying to update my Table (Referral) Field name (referdate) type Date
to be updated by using inputbox, where the user pass the number through the input box and then to this number to referdate to give me date + 2 days result. (example: inputbox 2 days, add 2 days to 20-12-2020 result is 22-12-2020)
the error I get (syntax error in the update statement)
my access version is 2013
my code below:
Dim S As Integer
S = InputBox(" How many days to follow", "Number of Days !")
DoCmd.RunSQL "UPDATE Referral" & _
"SET referdate = referdate" & Me.referdate + S & _
"where SRSno = " & Me.SRSno
Me.Refresh
According to the docs (https://learn.microsoft.com/en-us/office/client-developer/access/desktop-database-reference/update-statement-microsoft-access-sql), it seems that your statement might be including the existing column value being concatenated with the local variable.. Try this:
DoCmd.RunSQL "UPDATE Referral" & _
"SET referdate = " & Me.referdate + S & _
"where SRSno = " & Me.SRSno
The difference is subtle, but the Microsoft example shows adding a value as part of the query expression to the existing column value:
SET OrderAmount = OrderAmount * 1.1,
The alternative syntax for your case might be:
DoCmd.RunSQL "UPDATE Referral" & _
"SET referdate = referdate + " & S & _
"where SRSno = " & Me.SRSno
In either case, notice that referdate only appears once in the statement.
Include DateAdd and don't forget the spaces:
If Val(S) > 0 Then
DoCmd.RunSQL "UPDATE Referral " & _
"SET referdate = DateAdd('d', " & Val(S) & ", referdata) " & _
"WHERE SRSno = " & Me.SRSno & ""
End If

Run-time error '3021': Either BOF or EOF is True, or the current record has been deleted. Requested operation requires a current record

Getting this error out of an old VB6 app that I've been presented with updating. So I got XP Mode up and running and VB6 installed and updated on it and I've added the menu option that was requested of me, but now I'm getting this error.
There are several examples of this error or similar here on SO and I looked through a bunch of them, but the circumstances aren't exactly the same and I'm still a pretty newbie developer and I just need help. I tested the query I wrote on our dev server and the VB syntax around it, that part is working fine. I think it has something to do with the result set logic near the end:
Private Sub FillDoor()
Dim m_rsDoor As ADODB.Recordset
cboDoorStyle.Clear
Set m_rsDoor = conSQL.Execute("SELECT bpm.[Description] " & _
"FROM tblBrandProductMaster bpm " & _
"INNER JOIN tblDoorStyles ds " & _
"ON ds.DoorStyleCode = bpm.Code " & _
"INNER JOIN tblFamilyDoorStyles fds " & _
"ON bpm.Code = fds.DoorStyleCode " & _
"INNER JOIN tblFamilyLines fl " & _
"ON fds.FamilyLineCode = fl.FamilyLineCode " & _
"WHERE fl.FamilyLineCode = '" & strFamID & "' " & _
"AND ds.DFFactive = 1 " & _
"ORDER BY bpm.[Description] ASC")
Do While Not m_rsDoor.EOF
cboDoorStyle.AddItem m_rsDoor!Description
m_rsDoor.MoveNext
Loop
Set m_rsDoor = Nothing
End Sub
****Edit: I'm using that query to populate a particular drop-down in the app and it is working on both on the SQL server and in the app.
Some of the examples on here use an If loop instead of a Do While Not, but they both get the same thing done and I don't think that's the issue. I also don't think that's the issue because I copied and pasted that part from another menu option on the app and that option works when I click it. It only throws the error when I choose the option I added.
Thanks, I appreciate any help anyone can offer.
Modify like below code:
Private Sub FillDoor()
Dim m_rsDoor As ADODB.Recordset
Set m_rsDoor = New Recordset
Dim ActiveConnection as String
ActiveConnection = "XXXXXXXXXXX"
Dim strSQL as String
strSQL = "SELECT bpm.[Description] " & _
"FROM tblBrandProductMaster bpm " & _
"INNER JOIN tblDoorStyles ds " & _
"ON ds.DoorStyleCode = bpm.Code " & _
"INNER JOIN tblFamilyDoorStyles fds " & _
"ON bpm.Code = fds.DoorStyleCode " & _
"INNER JOIN tblFamilyLines fl " & _
"ON fds.FamilyLineCode = fl.FamilyLineCode " & _
"WHERE fl.FamilyLineCode = '" & strFamID & "' " & _
"AND ds.DFFactive = 1" & _
"ORDER BY bpm.[Description] ASC"
m_rsDoor.open strSQL, ActiveConnection, adOpenStatic, adLockOptimistic
Do While Not m_rsDoor.EOF
cboDoorStyle.AddItem m_rsDoor!Description
m_rsDoor.MoveNext
Loop
Set m_rsDoor = Nothing
End Sub
This error comes when there are no record in the record set. Please check if your query is correct and giving records.

Outlook VBScript run as rule

I'm a new user, so please go gentle on me.
I have created an Outlook rule that runs the below script which writes some of the email message properties to an SQL table.
The connection is working fine, when I run this as a macro on a selected message, it works fine... but when I leave it to run as a rule, it just keeps writing the currently selected email...
I can't figure out where I'm going wrong...
Code is below :
Sub TEST_TO_SQL(Item As MailItem)
Dim sSubject As String
Dim sTo As String
Dim sFrom As String
Dim sMsgeID As String
Dim sRcvd As Date
Set Item = Application.ActiveExplorer.Selection.Item(1)
sSubject = Item.Subject
sTo = Item.ReceivedByName
sFrom = Item.SenderEmailAddress
sMsgID = Item.EntryID
sRcvd = Item.ReceivedTime
Const adOpenStatic = 3
Const adLockOptimistic = 3
Set objConnection = CreateObject("ADODB.Connection")
Set objRecordSet = CreateObject("ADODB.Recordset")
objConnection.Open _
"Provider=SQLOLEDB;" & _
"Data Source=SQLSERVER\SQLEXPRESS;" & _
"Trusted_Connection=Yes;" & _
"InitialCatalog=SQLDB;" & _
"User ID=sa;Password=password;"
objRecordSet.Open _
"INSERT INTO [SQLDB].[dbo].[EMAIL_Log] (LogCompanyID, LogSubject, LogStartDate, LogEndDate, LogShortDesc, LogLongDesc, LogFrom, LogTo, LogMessageID, LogCategory1)" & _
"VALUES ('11'," & "'" & sSubject & "'" & ", " & "'" & Format(sRcvd, "yyyy-mm-dd hh:mm:ss", vbUseSystemDayOfWeek, vbUseSystem) & "'" & ", '', 'short desc', 'Long Desc', " & "'" & sFrom & "'" & ", " & "'" & sTo & "'" & ", " & "'" & sMsgID & "'" & ", '47')", objConnection, adOpenStatic, adLockOptimistic
End Sub
You're always using the currently selected mail item. Remove the line:
Set Item = Application.ActiveExplorer.Selection.Item(1)
Then Item will be the one passed in to the Sub

Access 2013 Insert / update

I have a form to add user.
I can add, delete rows in the table however I pretend to update if the user already exist.
My goal is press the row in sub form to edit.
but every time I press update it gives me an error.
Run-time error '3075' Syntax error operator in query expression.
the action code I have is this
Private Sub cmdAdd_Click()
'quando se carrega em Adicionar há 2 opcoes
'1-Insert
'2-Update
If Me.txtuserid.Tag & "" = "" Then
'1
CurrentDb.Execute "INSERT INTO user(userid, username, userfunction, usercc) " & _
" VALUES(" & Me.txtuserid & ",'" & Me.txtusername & "','" & Me.txtuserfun & "','" & Me.txtusercc & "')"
Else
'2
CurrentDb.Execute "UPDATE user " & _
" SET userid=" & Me.txtuserid & _
", username=" & Me.txtusername & "'" & _
", userfunction =" & Me.txtuserfun & "'" & _
", usercc =" & Me.txtusercc & "'" & _
" WHERE userid =" & Me.txtuserid.Tag
End If
'clear fields
cmdClear_Click
'refresh
SubForm1.Form.Requery
End Sub
What I'm doing wrong?
Did you miss ' in you update statement;
CurrentDb.Execute "UPDATE user " & _
" SET userid=" & Me.txtuserid & _
", username='" & Me.txtusername & "'" & _
", userfunction ='" & Me.txtuserfun & "'" & _
", usercc ='" & Me.txtusercc & "'" & _
" WHERE userid =" & Me.txtuserid.Tag

Runtime error 3704

In my vb6 I am getting error 3704 operation is not allowed when object is closed.
I have search stackoverflow for similar problem but I think I'm missing something. I need to update every row in vfp based from recordset rs1 Here my code:
Option Explicit
Dim cn As New ADODB.Connection
Dim cn1 As New ADODB.Connection
Private Sub trns_Click()
Set cn = New ADODB.Connection
Set cn1 = New ADODB.Connection
cn.ConnectionString = MDI1.txtcn.Text
cn.Open
cn1.ConnectionString = "Provider=VFPOLEDB;Data Source=\\host1\software\MIL\company0"
cn1.Open
rs1.Open "Select * from trans", cn, adOpenStatic, adLockPessimistic
Do While Not rs2.EOF
rs2.Open "update transac set no_ot_1_5 = " & rs1.Fields("ovt1") & ", no_ot_2_0 = " & rs1.Fields("ovt2") & ", no_ot_3_0" _
& "= " & rs1.Fields("ovt3") & ",Meal_allw = " & rs1.Fields("meal_allow") & ",on_duty = " & rs1.Fields("cnt") & ",no_d_local = " & rs1.Fields("local") & ",no_d_sick" _
& "= " & rs1.Fields("sick") & ",no_d_abs = " & rs1.Fields("absence") & ",no_d_spc = " & rs1.Fields("special") & ",Revenue02" _
& "= " & rs1.Fields("refund") & ",Revenue05 = " & rs1.Fields("prepay") & ",Deduct05 = " & rs1.Fields("prepay") & ",Revenue01 = " & rs1.Fields("comm") & "where code = '" & rs1.Fields("emp_code") & "' and transac.date = CTOD('" & trans.txtend2 & "')", cn1, adOpenDynamic, adLockPessimistic
If Not rs2.EOF Then
rs2.MoveNext
End If
Loop
rs2.close
Update query doesn't return recordset, hence your rs2 is not opened.
You perform your loop on the wrong recordeset : I replaced the some of the rs2 with rs1 in your code.
Do While Not rs1.EOF
rs2.Open "update transac set no_ot_1_5 = " & rs1.Fields("ovt1") & ", no_ot_2_0 = " & rs1.Fields("ovt2") & ", no_ot_3_0" _
& "= " & rs1.Fields("ovt3") & ",Meal_allw = " & rs1.Fields("meal_allow") & ",on_duty = " & rs1.Fields("cnt") & ",no_d_local = " & rs1.Fields("local") & ",no_d_sick" _
& "= " & rs1.Fields("sick") & ",no_d_abs = " & rs1.Fields("absence") & ",no_d_spc = " & rs1.Fields("special") & ",Revenue02" _
& "= " & rs1.Fields("refund") & ",Revenue05 = " & rs1.Fields("prepay") & ",Deduct05 = " & rs1.Fields("prepay") & ",Revenue01 = " & rs1.Fields("comm") & "where code = '" & rs1.Fields("emp_code") & "' and transac.date = CTOD('" & trans.txtend2 & "')", cn1, adOpenDynamic, adLockPessimistic
If Not rs1.EOF Then
rs1.MoveNext
End If
Loop
rs1.close
You dont need to create a recordset to execute an update, insert or delete on the database. Just use the statement cn1.Execute YourSqlStatement where YourSqlStatement is the string you are passing on the rs2.Open instruction. The Execute method on the connection optionally accepts a byRef variable where you can get the number of records affected.
Example:
Dim nRecords As Integer
cn1.Execute "Update Table Set Field = Value Where AnotherField = SomeValue ", nRecords
MsgBox "Total Updated Records: " & Format(nRecords,"0")
try to open your rs2 before using if in the do while statement., or do it like this
rs2.open " blah blah blah "
Do Until rs2.eof
For Each fld In rs2.field
value_holder = fld.value
Next
rs2.movenext
Loop

Resources