|
I think there's no way to do this with databinding, you need to write a loop and add the items yourself.
Christian Graus
Driven to the arms of OSX by Vista.
|
|
|
|
|
|
Hello Everyone,
I need to send simple textual data on a serial port of a remote machine using VB.NET . I just need a Windows app. with A server and a client side s/w.
Please help me.
Fahad Siddiqui
|
|
|
|
|
Hmm, it will be very hard to help you as you didn't even ask a question.
But the most help I can give you right now is right here... Google[^]
The best way to accelerate a Macintosh is at 9.8m/sec² - Marcus Dolengo
|
|
|
|
|
(Using Visual Studio 2008)
I am trying to learn how to add functionality to the MonthCalendar control. I have looked at the C# example at this url http://www.codeproject.com/KB/selection/MonthCalendar.aspx[^]
However I am not a C# guy, and the custom control is a bit over kill.
Specifically, all I want to do is add the ability to set the color of a BoldedDate, either the forecolor or the back color. The C# example is nice, but it lacks the ability to have a 4x3 grid of calendars like the MonthCalendar has.
I have already created a Class with some code examples to add functionality for a double click event as follows:
Thanks
J
Public Class ExtendedMonthCalendar
Inherits MonthCalendar
Private m_LastClickPosition As Point
Private m_LastClickTime As Long
Private m_LastClickRaisedDoubleClick As Boolean
Public Shadows Event DoubleClick( _
ByVal sender As Object, _
ByVal e As EventArgs _
)
#Region "Events"
Protected Overrides Sub OnDoubleClick(ByVal e As EventArgs)
RaiseEvent DoubleClick(Me, e)
End Sub
Protected Overrides Sub OnMouseDown(ByVal e As MouseEventArgs)
If e.Button = MouseButtons.Left Then
If _
Not m_LastClickRaisedDoubleClick AndAlso _
Now.Ticks - m_LastClickTime <= _
SystemInformation.DoubleClickTime * 10000 AndAlso _
IsInDoubleClickArea(m_LastClickPosition, Cursor.Position) _
Then
OnDoubleClick(EventArgs.Empty)
m_LastClickRaisedDoubleClick = True
Else
m_LastClickRaisedDoubleClick = False
End If
m_LastClickPosition = Cursor.Position
m_LastClickTime = Now.Ticks
End If
MyBase.OnMouseDown(e)
End Sub
Private Function IsInDoubleClickArea( _
ByVal Point1 As Point, _
ByVal Point2 As Point _
) As Boolean
Return _
Math.Abs(Point1.X - Point2.X) <= SystemInformation.DoubleClickSize.Width AndAlso _
Math.Abs(Point1.Y - Point2.Y) <= SystemInformation.DoubleClickSize.Height
End Function
#End Region
End Class
|
|
|
|
|
Member 2713401 wrote: However I am not a C# guy, and the custom control is a bit over kill.
You know far more about C# than you think you do. Remove all the semi-colons and C# starts to look a lot like VB.NET. Let me give you a hint. These two code blocks are identical:
C#: int n = 0;
Pen myPen = new Pen(Color.Black);
VB.NET: Dim n As Integer = 0
Dim myPen As New Pen(Color.Black)
The rest is easy...
As for your control, you have to handle the Paint event, have the control paint itself and then supply the drawing code to paint the current date as the color you want. The example you linked to does exactly that. It's just a matter of filtering out all the stuff you don't need. Start with a simple example. Handle the Paint event and try to get the control to paint itself first, then draw a line acrossed the control.
MyBase.Paint(e)
' Your drawing code goes here
|
|
|
|
|
Okay, well, I found similar C# code snippits, here http://forums.techpowerup.com/showthread.php?t=70554[^]
And decided that this was simple enough, no thrills not all the extra stuff.
So I converted everything to VB using SharpDevelop - (it is pretty handy )
I created a simple Control using the ctlClock example from Microsoft as a guideline. The control is simple in that all it does is add the ability to set the background on specific dates, bold or not bold, and a box or no box with color.
I am stuck... The project compiles with no errors.However when I create a test form in my project and try to add my newly created MonthCalendar, I get an error.
"Failed to create component 'ExtendedMonthCalendar'. The error message follows:
'System.NullReferenceException: Object Reference not set to instance of an object. ... " The error points to the Sub New where the testing created a control on the Control Design (at least that is what I think it was doing).
If I comment the code, when I add the control to my form it is blank.
If I try to add the class that is inheriting the monthcalendar to my control design, I get a different error related to the constructor of the MonCal
My code is below - converted from another example in trying to understand all of this... all of this is kept in the Control Code
any help would be appreciated.
J
Partial Public Class ExtendedMonthCalendar
Private MyDates As List(Of HighlightedDates)
Public Sub New()
InitializeComponent()
' Dates would normally be passed in, in a List. For testing purposes I added the next declaration
'MyDates.Add(New HighlightedDates(Convert.ToDateTime("9/1/2008"), Color.Red, Color.Blue, Color.Pink, True))
'Dim mCal As New MonCal(MyDates)
'Me.Controls.Add(mCal)
End Sub
End Class
Friend Class MonCal
Inherits MonthCalendar
Protected Shared WM_PAINT As Integer = 15
Private dayBox As Rectangle
Private dayTop As Integer = 0
Private range As SelectionRange
Private highlightedDates As New List(Of HighlightedDates)()
Public Sub New(ByVal HighlightedDates As List(Of HighlightedDates))
Me.ShowTodayCircle = False
Me.highlightedDates = HighlightedDates
range = GetDisplayRange(False)
SetDayBoxSize()
SetPosition(Me.highlightedDates)
End Sub
' This method figures out the size of the entire date area portion of the control
' and then divides it up o create a Rectagle for painting to individual dates
Private Sub SetDayBoxSize()
Dim bottom As Integer = Me.Height
While HitTest(1, dayTop).HitArea <> HitArea.[Date] AndAlso HitTest(1, dayTop).HitArea <> HitArea.PrevMonthDate
dayTop += 1
End While
While HitTest(1, bottom).HitArea <> HitArea.[Date] AndAlso HitTest(1, bottom).HitArea <> HitArea.NextMonthDate
bottom -= 1
End While
dayBox = New Rectangle()
dayBox.Size = New Size(Me.Width / 7, (bottom - dayTop) / 6)
End Sub
' This method determines where in the 7 x 6 array of dates on the control our highlighted dates reside.
Private Sub SetPosition(ByVal hlDates As List(Of HighlightedDates))
Dim row As Integer = 0, col As Integer = 0
hlDates.ForEach(AddressOf ConvertedAnonymousMethod1)
End Sub
' This overrides the message pump and traps the WM_PAINT call
Protected Overloads Overrides Sub WndProc(ByRef m As Message)
MyBase.WndProc(m)
If m.Msg = WM_PAINT Then
Dim g As Graphics = Graphics.FromHwnd(Me.Handle)
Dim pea As New PaintEventArgs(g, New Rectangle(0, 0, Me.Width, Me.Height))
OnPaint(pea)
End If
End Sub
' Here is where we use our information to selectively draw what we want
Protected Overloads Overrides Sub OnPaint(ByVal e As PaintEventArgs)
MyBase.OnPaint(e)
Dim g As Graphics = e.Graphics
Dim backgroundRect As Rectangle
highlightedDates.ForEach(AddressOf ConvertedAnonymousMethod2)
End Sub
Private Sub ConvertedAnonymousMethod1(ByVal [date] As HighlightedDates)
If [date].[Date] >= range.Start AndAlso [date].[Date] <= range.[End] Then
Dim span As TimeSpan = [date].[Date].Subtract(range.Start)
Dim row = span.Days / 7
Dim col = span.Days Mod 7
[date].Position = New Point(row, col)
End If
End Sub
Private Sub ConvertedAnonymousMethod2(ByVal [date] As HighlightedDates)
Dim g As Graphics
Dim backgroundRect = New Rectangle([date].Position.Y * dayBox.Width + 1, [date].Position.X * dayBox.Height + dayTop, dayBox.Width, dayBox.Height)
If [date].BackgroundColor <> Color.Empty Then
Using brush As Brush = New SolidBrush([date].BackgroundColor)
g.FillRectangle(brush, backgroundRect)
End Using
End If
If [date].Bold OrElse [date].DateColor <> Color.Empty Then
Using textFont As New Font(Font, (IIf([date].Bold, FontStyle.Bold, FontStyle.Regular)))
TextRenderer.DrawText(g, [date].[Date].Day.ToString(), textFont, backgroundRect, [date].DateColor, TextFormatFlags.HorizontalCenter Or TextFormatFlags.VerticalCenter)
End Using
End If
If [date].BoxColor <> Color.Empty Then
Using pen As New Pen([date].BoxColor)
Dim boxRect As New Rectangle([date].Position.Y * dayBox.Width + 1, [date].Position.X * dayBox.Height + dayTop, dayBox.Width, dayBox.Height)
g.DrawRectangle(pen, boxRect)
End Using
End If
End Sub
End Class
Friend Class HighlightedDates
Public [Date] As DateTime
Public Position As New Point(0, 0)
Public DateColor As Color
Public BoxColor As Color
Public BackgroundColor As Color
Public Bold As Boolean
' This constructor is used if you only want to make dates bold. All colors are set to "Empty"(null color)
Public Sub New(ByVal [date] As DateTime)
Me.[Date] = [date]
Me.DateColor = Color.Empty
Me.BoxColor = Color.Empty
Me.BackgroundColor = Color.Empty
Me.Bold = True
End Sub
' This constructor is used if you want colored and/or bolded dates
Public Sub New(ByVal [date] As DateTime, ByVal dateColor As Color, ByVal bold As Boolean)
Me.[Date] = [date]
Me.DateColor = dateColor
Me.BoxColor = Color.Empty
Me.BackgroundColor = Color.Empty
Me.Bold = bold
End Sub
' This constructor is used when you want to control everything
Public Sub New(ByVal [date] As DateTime, ByVal dateColor As Color, ByVal boxColor As Color, ByVal backgroundColor As Color, ByVal bold As Boolean)
Me.[Date] = [date]
Me.DateColor = dateColor
Me.BoxColor = boxColor
Me.BackgroundColor = backgroundColor
Me.Bold = bold
End Sub
End Class
|
|
|
|
|
Private MyDates As List(Of HighlightedDates)
Public Sub New()
InitializeComponent()
' Dates would normally be passed in, in a List. For testing purposes I added the next declaration
MyDates.Add(New HighlightedDates(Convert.ToDateTime("9/1/2008"), Color.Red, Color.Blue, Color.Pink, True))
Dim mCal As New MonCal(MyDates)
Me.Controls.Add(mCal)
End Sub
You didn't instantiate an instance of the List at the top of the New code. This is where you're problem lies. Your code should be:
Private MyDates As New List(Of HighlightedDates)
|
|
|
|
|
At this point I have a NullReferenceException
The MonthCalendar starts to draw on my Test Form, but then I get the errors.
It points to line 73, 58, and 50
73 is in this function
Private Sub ConvertedAnonymousMethod2(ByVal [date] As HighlightedDates)
Dim g As Graphics
Dim backgroundRect = New Rectangle([date].Position.Y * dayBox.Width + 1, [date].Position.X * dayBox.Height + dayTop, dayBox.Width, dayBox.Height)
If [date].BackgroundColor <> Color.Empty Then
Using brush As Brush = New SolidBrush([date].BackgroundColor)
g.FillRectangle(brush, backgroundRect)
End Using
End If
If [date].Bold OrElse [date].DateColor <> Color.Empty Then
Using textFont As New Font(Font, (IIf([date].Bold, FontStyle.Bold, FontStyle.Regular)))
TextRenderer.DrawText(g, [date].[Date].Day.ToString(), textFont, backgroundRect, [date].DateColor, TextFormatFlags.HorizontalCenter Or TextFormatFlags.VerticalCenter)
End Using
End If
If [date].BoxColor <> Color.Empty Then
Using pen As New Pen([date].BoxColor)
Dim boxRect As New Rectangle([date].Position.Y * dayBox.Width + 1, [date].Position.X * dayBox.Height + dayTop, dayBox.Width, dayBox.Height)
g.DrawRectangle(pen, boxRect)
End Using
End If
End Sub
Line 58 is this line
highlightedDates.ForEach(AddressOf ConvertedAnonymousMethod2)
Line 50 is this
Protected Overloads Overrides Sub WndProc(ByRef m As Message)
MyBase.WndProc(m)
If m.Msg = WM_PAINT Then
Dim g As Graphics = Graphics.FromHwnd(Me.Handle)
Dim pea As New PaintEventArgs(g, New Rectangle(0, 0, Me.Width, Me.Height))
OnPaint(pea)
End If
End Sub
|
|
|
|
|
smurfman87 wrote: Dim g As Graphics
...
g.FillRectangle(brush, backgroundRect)
Again, nowhere do you actually create an instance of a Graphics object. Normally, all of your painting is on in the Paint event and you get your Graphics object from the PaintEventArgs.
smurfman87 wrote: highlightedDates.ForEach(AddressOf ConvertedAnonymousMethod2)
Again, either highlightedDates is Nothing, or ConvertedAnonymousMethod2 is a delegate that points to Nothing.
smurfman87 wrote: Protected Overloads Overrides Sub WndProc(ByRef m As Message) MyBase.WndProc(m) If m.Msg = WM_PAINT Then Dim g As Graphics = Graphics.FromHwnd(Me.Handle) Dim pea As New PaintEventArgs(g, New Rectangle(0, 0, Me.Width, Me.Height)) OnPaint(pea) End If End Sub
I have no idea what you're doing with this code. This is normally handled by the base WndProc for you, so you're just reinventing the wheel here.
|
|
|
|
|
Dave Kreskowiak wrote: I have no idea what you're doing with this code. This is normally handled by the base WndProc for you, so you're just reinventing the wheel here.
This was a sample of code that I found, I don't fully understand what is taking place. How would I avoid re-inventing the wheel,  any suggestions.
Regarding the overall code, it was originally written in C#, but I converted to VB - one reason was to understand it better, but even when trying to impliment the code in a C# example, it would not compile.
I found variables not defined and others defined that didn't need to be present.
Dave Kreskowiak wrote: smurfman87 wrote:
Dim g As Graphics
...
g.FillRectangle(brush, backgroundRect)
Again, nowhere do you actually create an instance of a Graphics object. Normally, all of your painting is on in the Paint event and you get your Graphics object from the PaintEventArgs.
This example was one where the g.FillRectangle was reporting that g was not defined. My mistake was adding the Dim g as Graphics.
Protected Overloads Overrides Sub OnPaint(ByVal e As PaintEventArgs)
MyBase.OnPaint(e)
Dim g As Graphics = e.Graphics
'Dim backgroundRect As Rectangle
highlightedDates.ForEach(AddressOf ConvertedAnonymousMethod2)
End Sub
Lets say I wanted to move the logic of this function "ConvertedAnonymousMethod2" in the OnPaint event calling that function and where the g as graphics is obviously flawed, and I wanted to move it into the OnPaint Event... what could you suggest?
Thanks
J
|
|
|
|
|
Here is where I am at.
I re-wrote the OnPaint Sub and included the logic from the ConvertedAnonymousMethod2 and changed the code the for the highlighteddates.foreach(addressof ConvertedAnonymousMethod2)
This is what I came up with...
Protected Overloads Overrides Sub OnPaint(ByVal e As PaintEventArgs)
MyBase.OnPaint(e)
Dim g As Graphics = e.Graphics
'Dim backgroundRect As Rectangle
'highlightedDates.ForEach(AddressOf ConvertedAnonymousMethod2)
For Each [date] As HighlightedDates In highlightedDates
Dim backgroundRect = New Rectangle([date].Position.Y * dayBox.Width + 1, _
[date].Position.X * dayBox.Height + dayTop, _
dayBox.Width, dayBox.Height)
If [date].BackgroundColor <> Color.Empty Then
Using brush As Brush = New SolidBrush([date].BackgroundColor)
g.FillRectangle(brush, backgroundRect)
End Using
End If
If [date].Bold OrElse [date].DateColor <> Color.Empty Then
Using textFont As New Font(Font, (IIf([date].Bold, FontStyle.Bold, FontStyle.Regular)))
TextRenderer.DrawText(g, [date].[Date].Day.ToString(), _
textFont, backgroundRect, [date].DateColor, _
TextFormatFlags.HorizontalCenter Or TextFormatFlags.VerticalCenter)
End Using
End If
If [date].BoxColor <> Color.Empty Then
Using pen As New Pen([date].BoxColor)
Dim boxRect As New Rectangle([date].Position.Y * dayBox.Width + 1, _
[date].Position.X * dayBox.Height + dayTop, _
dayBox.Width, dayBox.Height)
g.DrawRectangle(pen, boxRect)
End Using
End If
Next
End Sub
So the whole thing compiles and I can add my ExtendedMonthCalendar as an object on my test form. And it draws a calendar - with no errors.
So this becomes where I am totally dumb.
The control appears on the form, but I can't do anything with it. Ie, I have non of the original functionality of the MonthCalendar control, and I can't even code into my form the adding of dates.
The other whacky thing is that the Hard Coded Date example in the New sub, ie December 1, 2008 is always at position of top left of the calendar control and is behaving weird.
As always I apprecaite the learning.
J
|
|
|
|
|
I have inherited a web scraper where I work that scrapes down information from a site that we work with a lot, so we don't have to always log into the site and download/upload information manually.
It goes out and grabs the web page, and loads it locally into an mshtml.HTMLDocument. The company that keeps up this site has apparently added AJAX to the website, so I am now getting an error (ASP.NET Ajax client-side framework failed to load.) when trying to write to the HTMLdocument, which appears to be coming from the "if (typeof(Sys) === 'undefined') throw new Error('ASP.NET Ajax client-side framework failed to load.');" line on the page.
Private Function GetHTMLBody(ByVal pHtml As String) As IHTMLElement2
Dim myDoc As mshtml.IHTMLDocument2 = New mshtml.HTMLDocument
Dim elmBody As mshtml.IHTMLElement
Dim elmBody2 As mshtml.IHTMLElement2
'initialize the document object within the HTMLDocument class...
myDoc.close()
myDoc.open("about:blank")
'write the HTML to the document using the MSHTML "write" method...
Dim clsHTML() As Object = {pHtml}
myDoc.write(clsHTML)
clsHTML = Nothing
elmBody = myDoc.body()
elmBody2 = DirectCast(elmBody, IHTMLElement2)
myDoc.close()
Return elmBody2
End Function
Above is the function that is causing the problem. The error occurs on the "myDoc.write(clsHTML)" line.
If anybody could give me some direction on this, it would be greatly appreciated.
modified on Wednesday, December 17, 2008 4:44 PM
|
|
|
|
|
use a regex to remove the line ?
Christian Graus
Driven to the arms of OSX by Vista.
|
|
|
|
|
I have stripped this down to a very basic html page of the following:
<pre><html>
<body>
<form name="aspnetForm" method="post" action="PortalLogin.aspx?ReturnUrl=%2fportal%2fetaportal.asp%3fapp%3dCWA" id="aspnetForm">
<script src="/ETASSOPortal/Telerik.Web.UI.WebResource.axd?_TSM_HiddenField_=ctl00_RadScriptManager1_HiddenField&compress=1&_TSM_CombinedScripts_=%3b%3bSystem.Web.Extensions%2c+Version%3d3.5.0.0%2c+Culture%3dneutral%2c+PublicKeyToken%3d31bf3856ad364e35%3aen-US%3a94b8a2b4-5efc-4f4c-9641-d912b698978d%3a52817a7d%3bTelerik.Web.UI%2c+Version%3d2008.2.1001.35%2c+Culture%3dneutral%2c+PublicKeyToken%3d121fae78165ba3d4%3aen-US%3a9638cb27-0c96-4947-a8f4-d97afe664a61%3a393f5085%3a34f9d57d%3a5edc7ae2%3a251a9451%3a526d426%3a81330300%3ac6335cbd" type="text/javascript"></script>
<script type="text/javascript">
//<![CDATA[
if (typeof(Sys) === 'undefined') throw new Error('ASP.NET Ajax client-side framework failed to load.');
//]]>
</script>
<strong>Looky Here</strong>
</body>
</html></pre>
And it appears the actual line that is causing the problem is the line of "<script src =......". When I added this line, my small example produced the same error as my original post, and then when I take it out, the error goes away.
Anybody know what might be causing this error?
|
|
|
|
|
i am doing a project in which it is required to send and read data from serial port to visual studio 2005.i hav to send datas like 1,2,3,etc to serial port and read what ever data is sent by microcontroller to serial port to a text box.I searched the net for codes but none of them suited my requirement.so please send me a working code and also tell me how to incorporate the code in my project.please help me out as soon as possible....
|
|
|
|
|
|
The System.IO.Ports.SerialPort class is what you need.
There are several articles about it here on CP.
vivekmenon1706 wrote: send me a working code
I don't think so.
vivekmenon1706 wrote: as soon as possible
I am not impressed. If you are in a hurry it tells me you started out too late...
|
|
|
|
|
Hey guys, I never thought my post would appear the way it did on the page.
Sorry for any inconvenience. this is my first time posting so i guess I really dont know how the Message editor of the forum works.
Sorry.
|
|
|
|
|
It is not too bad for a first message. You even managed to publish formatted code, something that is rare in the VB forum for unknown reasons.
[EDIT]Breaking up your SQL statement to reduce the source width would have made things more readable though...[/EDIT]
FYI: you can still edit your message, after you have posted it. And you can reply to it if you want to add information. There is no need to start a new thread at all, keep it all together, that is easier to all of us.
|
|
|
|
|
Hello experts,
I am really stumped on this one. I have a VB6 front end tool to log in customer queris and the corresponding resolutions with start and end timestamps, customer name,email, phone number etc. Each customer interation is logged into the database via the application into the database and needs to be tagged with a unique ID.
The requirement is that I need to generate the ID every time a new case is logged in the program and save the information to a temporary table first and then push it to the main table. this is ecause there are multiple users for the application and in order to avoid dupliation of the Case ID I have used the "idReturn" sub procedure to find the last updated ID and increment it to log a new case in the table.
The problem is that the new case ID does not enerate in spite of the procedure I added , because the query in subprocedure "cmdUpdate_Click()" does not update the main table form the temporary table. Easch user would run an instance of the application from his or her own systema nd according to the a parameter set from the login form, another field called "RepID" will be updated in the table whe they log a case by clicking on the "Update" Command button after which the next Case Id should be generated. i guess I am kinda looking for a Token system to make sure that when a record has been updated with a unique case ID, the next user to press the update button to log a case should e given the next new unique ID dynamically created to store in the database.
Any suggestions? Or could someone please direct me to some examples of Multi_user database programs in VB6 with similar record lock criteria?
I can send anyone the source code if they wish to analyse it further.
The database record would look like this
ID Date Month Weekday Time Originator CustName.. etc
1 27.05.2008 December Tuesday 9:00:00AM Distributor Vicky West.etc
.
.
.
Please see the code for the form below. Sorry if it is toooooo looooooong!
Option Explicit
Public strword, intplace, idlast
Dim temp As Long
Dim currID As String
Private Sub cmdAdd_Click()
Data1.Recordset.AddNew
Dim temp As Long
date.Text = DateValue(Now)
Dim m
m = Month(Now)
monthnam.Text = MonthName(m, False)
weekd.Text = WeekdayName(Weekday(Now))
time.Text = TimeValue(Now)
starttime = Now
orig.Text = ""
Text1.Text = ""
copname.Text = ""
contactno.Text = ""
contemail.Text = ""
qrytype.Text = ""
prodcode.Text = ""
mel.Text = ""
vendcode.Text = ""
batchlot.Text = ""
saleval.Text = ""
qry.Text = ""
answer.Text = ""
sourcecontact.Text = ""
status.Text = ""
cmdAdd.Visible = False
cmdUpdate.Enabled = True
End Sub
Private Sub cmdRefresh_Click()
End Sub
Private Sub cmdUpdate_Click()
cmdUpdate.Enabled = False
cmdAdd.Visible = True
cmdAdd.Enabled = True
If status.Text = "Closed" Then
endtime = Now
End If
Data1.Recordset.Update
Dim conn As New ADODB.Connection
Dim mydb As Database
Dim qd As QueryDef
Dim CONNECT_STRING As String
CONNECT_STRING = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=\\10.192.16.21\global\uktech\db\uktech.mdb"
Dim RS As Recordset
Set RS = New Recordset
'Generate a SQL
Dim strSQL
strSQL = "INSERT INTO main ([ID],[Date], [Month], Weekday, [Time], Originator, [First & Last Name], [Company name], [Contact No], [Contact Email], [Type of query], [Product code], MEL, [Vendor code], [Batch/Lot/Serial], [Sale value (GBP)], QUERY, ANSWER, STATUS, REPID, ContactSource, starttime, endtime, totaltime, Methcontact )"
strSQL = strSQL & "SELECT [ID],[Date], [Month], [Weekday], [Time], [Originator], [First & Last Name], [Company name], [Contact No], [Contact Email], [Type of query], [Product code], [MEL], [Vendor code], [Batch/Lot/Serial], [Sale value (GBP)], [QUERY], [ANSWER], [STATUS], [REPID], [ContactSource], [starttime], [endtime], [totaltime], [Methcontact]"
strSQL = strSQL & "FROM tempmain;"
With RS
.Open strSQL, CONNECT_STRING
End With
Set RS = NothingCall idReturn
Call idReturn
Call deleteTemptable
End Sub
Private Sub Command1_Click()
Dim strSQL1 As String
Dim key As String
key = Text2.Text
'This specifies the SQL to be executed
strSQL1 = "SELECT DISTINCT * "
strSQL1 = strSQL1 & "FROM [qa]where QUERY LIKE '%" & key & "%'"
'This specifies that the type of the ADODC is for SQL
Adodc1.CommandType = adCmdText
'This assigns the SQL result to the ADODC
Adodc1.RecordSource = strSQL1
Adodc1.Refresh
'Adodc1.Recordset.Requery
'The result from the SQL will then be used
'to populate the datagrid
Set DataGrid1.DataSource = Adodc1
DataGrid1.Columns(0).Width = 7300
DataGrid1.Columns(1).Width = 7200
DataGrid1.AllowUpdate = False
End Sub
Private Sub Command2_Click()
Adodc1.Recordset.AddNew
Adodc1.Recordset(0) = qry.Text
Adodc1.Recordset(1) = answer.Text
Adodc1.Recordset.Update
End Sub
Private Sub Command3_Click()
Form3.Show
Unload Me
End Sub
Private Sub Form_Click()
Call idReturn
End Sub
Private Sub Form_Load()
Call idReturn
cmdAdd_Click
cmdAdd.Enabled = False
DataGrid1.AllowUpdate = False
DataGrid1.Columns(0).Width = 7300
DataGrid1.Columns(0).Caption = "QUERY"
DataGrid1.Columns(1).Width = 7300
DataGrid1.Columns(1).Caption = "ANSWER"
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call idReturn
End Sub
Private Sub Option1_Click()
methcontact.Text = "Call"
End Sub
Private Sub Option2_Click()
methcontact.Text = "Email"
End Sub
Private Sub orig_Click()
Combo1.Visible = True
orig.Visible = False
End Sub
Private Sub combo1_Click()
orig.Text = Combo1.Text
Combo1.Visible = False
orig.Visible = True
End Sub
Private Sub qry_GotFocus()
strword = ""
intplace = 0
End Sub
Private Sub qrytype_Click()
Combo2.Visible = True
qrytype.Visible = False
End Sub
Private Sub Combo2_click()
qrytype.Text = Combo2.Text
Combo2.Visible = False
qrytype.Visible = True
End Sub
Private Sub sourcecontact_Click()
Combo4.Visible = True
sourcecontact.Visible = False
End Sub
Private Sub status_Click()
Combo3.Visible = True
status.Visible = False
If status.Text = "Closed" Then
endtime = Now
End If
End Sub
Private Sub combo3_Click()
status.Text = Combo3.Text
Combo3.Visible = False
status.Visible = True
End Sub
Private Sub combo4_Click()
sourcecontact.Text = Combo4.Text
If Combo4.Text = "Others" Then
sourcecontact.Text = ""
MsgBox "Please Specify The Customer's Source Of Contact Information in this Text Box", , "Contact Source Details"
sourcecontact.SetFocus
End If
Combo4.Visible = False
sourcecontact.Visible = True
End Sub
Public Sub idReturn()
Dim CONNECT_STRING As String
CONNECT_STRING = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=\\10.192.16.21\global\uktech\db\uktech.mdb"
Dim RS As Recordset
Set RS = New Recordset
'Generate a SQL
Dim strSQL As String
strSQL = "select count(*) from main "
With RS
.Open strSQL, CONNECT_STRING
End With
temp = RS(0)
id.Text = temp + 1
RS.Requery
RS.Close
Set RS = Nothing
End Sub
Private Sub deleteTemptable()
Dim conn As New ADODB.Connection
Dim mydb As Database
Dim qd As QueryDef
With conn 'this reliably opens a connection
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=\\10.192.16.21\global\uktech\db\uktech.mdb"
.Open
End With
Set mydb = OpenDatabase("\\10.192.16.21\global\uktech\db\uktech.mdb")
Set qd = mydb.QueryDefs("deletetemp")
Call qd.Execute
End Sub
Thanks in advance and Best Regards,
Kumar (kshincsk@gmail.com)
|
|
|
|
|
The problem with generating the case ID first is that two users can get caseIDs before either one is written to the database. Your primary key shouldn't be generated and should NOT be calculated until the record using it is written to the database. You don't checkout a case ID first, you get it last, after certain minimum data is written to the database.
Also, Access is NOT a good candidate for a multiuser database. Yes, there are people around here who will argue that point, but I've supported too many of these and had to fix too many problems with them to given these people any credit.
|
|
|
|
|
Hello Dave,
Thank you very much for your input. I tried it. First, I had the user form update the temporary table via ADODC control and then wrote a query to insert the record to the main table from the temporary table. Then I used the data1.recordset.delete method to delete the temporary table.
The problem is the data is not transferrin from the temporary table to the main table but the temporary table is deleted. The result is that there is no addition to the main table.
Could you help me with this please?
Regards,
Kumar
kshincsk@gmail.com
|
|
|
|
|
Simple, don't use a temporary table. You're just needlessly making more "round trips" to the database and doing stuff that isn't really buying you anything.
|
|
|
|
|
Thanks a lot for the advice. I just created a record off the fly and used it to retrieve the ID with minimum value and "Flag=N" meaning it has ot been used for ay update. Then , I insert the data based on the text fields in my form. then I change the "Flag" field to 'Y' to say that this particular record has been used and use the followind method. Then I used the "idreturn" method to return the lowest value of ID with Flag=N. Worked like a charm!!! Absolutely no multi-user conflicts since each user would be opening a different record at the same time.
<br />
Dim strsql<br />
Dim conn As New ADODB.Connection<br />
Dim rs As New ADODB.Recordset<br />
strsql = "SELECT * "<br />
strsql = strsql & "FROM main "<br />
strsql = strsql & "WHERE Flag ='N' AND ID=" & temp<br />
<br />
With conn 'this reliably opens a connection<br />
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=\\10.192.16.21\global\uktech\db\uktech.mdb"<br />
.Open<br />
<br />
End With<br />
<br />
With rs<br />
<br />
.Open strsql, conn, adOpenStatic, adLockOptimistic<br />
<br />
<br />
End With<br />
'Insert code here to update the Recordset with the txt box values<br />
.<br />
.<br />
.<br />
.<br />
.<br />
.<br />
.<br />
rs.update<br />
set rs= nothing<br />
End Sub<br />
<br />
.<br />
.<br />
.<br />
<br />
Public Sub idReturn()<br />
<br />
Dim CONNECT_STRING As String<br />
<br />
CONNECT_STRING = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=\\10.192.16.21\global\uktech\db\uktech.mdb"<br />
<br />
Dim rs As Recordset<br />
<br />
Set rs = New Recordset<br />
<br />
'Generate a SQL<br />
Dim strsql As String<br />
<br />
strsql = "select MIN(ID) from main WHERE Flag='N'"<br />
<br />
With rs<br />
.Open strsql, CONNECT_STRING<br />
<br />
End With<br />
<br />
temp = rs(0)<br />
id.Text = temp<br />
rs.Requery<br />
rs.Close<br />
Set rs = Nothing<br />
<br />
End Sub
I got promoted to System Analyst on Friday a couple of hours after I showed my manager this program. This makes it the 7th app I have developed since I joined work October last year.
Thanks for your support.
Best regards,
Kumar
|
|
|
|
|
General 
News 
Suggestion 
Question 
Bug 
Answer 
Joke 
Praise 
Rant 
Admin 
Submit an article or tip
