|
Hi all,
Member 10410323 : This project should help you to find how to send e-mails with VB6.
Mycroft Holmes : I agree with you, new projects should be coded with the latest versions of Visual Studio, but we don't know anything about Member10410323, mabe he has only VS6 platform...
For fun - (about the ZX Spect) it was made in 1982, take a look at This Link
You can see that the Basic instructions are directly written in the keyboard keys 
We should save our applications into an old audio tape (no hard disk on it) the real stone age 
See you
|
|
|
|
|
|
Krishna Kamal wrote: Can u kindly suggest the proper procedure for overcoming the situation.
Yes, fix your code. But if you want help from here, then you need to provide some proper details of your code and where the error occurs.
|
|
|
|
|
Option Explicit
Dim srv As New OPCServer \\the error code is showing on this area{The MSDN collection does not
exist;Please reinstall MSDN}\\
Dim StrName As String
Dim WithEvents grp As OPCGroup
Dim itm As OPCItem
Dim StrQuery As String
Dim StrQuery1 As String
Dim StrRepQuery As String
Dim strFromDate As String
Dim strToDate As String
Dim Cn As ADODB.Connection
Dim Rst As ADODB.Recordset
Dim RepRst As ADODB.Recordset
Dim TempRst As ADODB.Recordset
Private Function Validate()
If IsNull(DTPFromDate.Value) Or IsNull(DTPToDate.Value) Then
MsgBox "Please Select From & To Date.", vbInformation, "Date Massage."
Validate = True
Else
Validate = False
End If
End Function
Private Sub RepQuary()
On Error GoTo ErrorHandler
StrRepQuery = ""
StrRepQuery = "SELECT UNIQUEID AS UID FROM TAGDETAIL WHERE UCASE(TAGNAME) LIKE '%" & UCase(StrName) & "%'"
Set RepRst = Cn.Execute(StrRepQuery)
strFromDate = Format(DTPFromDate.Value, "dd-MMM-yyyy") & " " & Format(DTPFTime.Value, "HH:MM:SS")
strToDate = Format(DTPToDate.Value, "dd-MMM-yyyy") & " " & Format(DTPToTime.Value, "HH:MM:SS")
If RepRst.EOF = False Then
If Not IsNull(DTPFromDate.Value) And Not IsNull(DTPToDate.Value) Then
StrRepQuery = "SELECT *FROM TAGVALUE WHERE ParentID = " & RepRst!UID & " AND VALDATE >=#" & strFromDate & "# AND VALDATE <= #" & strToDate & "# ORDER BY VALDATE,VALTIME"
End If
End If
Exit Sub
ErrorHandler:
Exit Sub
End Sub
Private Sub CmdDMConductivity_Click()
If Validate = True Then Exit Sub
StrName = ""
StrName = "DM Water Conductivity"
Call RepQuary
SaveDataintoExcel
End Sub
Private Sub CmdDMSilica_Click()
If Validate = True Then Exit Sub
StrName = ""
StrName = "DM Water Silica"
Call RepQuary
SaveDataintoExcel
End Sub
Private Sub CmdDmWaterPH_Click()
If Validate = True Then Exit Sub
StrName = ""
StrName = "DM Water pH"
Call RepQuary
SaveDataintoExcel
End Sub
Private Sub CmdFile_Click()
On Error GoTo ErrorHandler
Dim FoldName As String, RowNo As Integer
CommonDialog1.ShowSave
FoldName = CommonDialog1.FileName
If FoldName = "" Then Exit Sub
If Len(FoldName) > 3 Then
If Right(FoldName, 4) <> ".xls" Then
FoldName = FoldName & ".xls"
End If
End If
txtFileName = FoldName
Exit Sub
ErrorHandler:
Exit Sub
End Sub
Private Sub CmdMBConductivity_Click()
If Validate = True Then Exit Sub
StrName = ""
StrName = "MB Conductivity"
Call RepQuary
SaveDataintoExcel
End Sub
Private Sub CmdMBpH_Click()
If Validate = True Then Exit Sub
StrName = ""
StrName = "MB pH"
Call RepQuary
SaveDataintoExcel
End Sub
Private Sub CmdORP_Click()
If Validate = True Then Exit Sub
StrName = ""
StrName = "ORP"
Call RepQuary
SaveDataintoExcel
End Sub
Private Sub CmdROA_Click()
If Validate = True Then Exit Sub
StrName = ""
StrName = "RO A Salt Passage"
Call RepQuary
SaveDataintoExcel
End Sub
Private Sub CmdROB_Click()
If Validate = True Then Exit Sub
StrName = ""
StrName = "RO B Salt Passage"
Call RepQuary
SaveDataintoExcel
End Sub
Private Sub CmdROC_Click()
If Validate = True Then Exit Sub
StrName = ""
StrName = "RO C Salt Passage"
Call RepQuary
SaveDataintoExcel
End Sub
Private Sub CmdWaterFlow_Click()
If Validate = True Then Exit Sub
StrName = ""
StrName = "DM Water Flow"
Call RepQuary
SaveDataintoExcel
End Sub
Private Sub CmdWaterPressure_Click()
If Validate = True Then Exit Sub
StrName = ""
StrName = "DM Water Pressure"
Call RepQuary
SaveDataintoExcel
End Sub
Private Sub Form_Load()
srv.Connect "RSLinx OPC Server"
Set grp = srv.OPCGroups.Add("AA")
''' grp.OPCItems.AddItem "[TOPICNAME]TagName1", 1
''' grp.OPCItems.AddItem "[TOPICNAME]TagName2", 2
'FOR DM WATER pH
grp.OPCItems.AddItem "[tisco_pri_mod_230607]F8:72", 1
'FOR DM WATER CONDUCTIVITY
grp.OPCItems.AddItem "[tisco_pri_mod_230607]F8:99", 2
'FOR DM WATER SILICA
grp.OPCItems.AddItem "[tisco_pri_mod_230607]F8:2", 3
'FOR DM WATER FLOW
grp.OPCItems.AddItem "[tisco_pri_mod_230607]F8:54", 4
'FOR DM WATER PRESSURE
grp.OPCItems.AddItem "[tisco_pri_mod_230607]F8:1", 5
'FOR RO A SALT PASSAGE
grp.OPCItems.AddItem "[tisco_pri_mod_230607]F8:164", 6
grp.OPCItems.AddItem "[tisco_pri_mod_230607]F8:163", 7
'FOR RO B SALT PASSAGE
grp.OPCItems.AddItem "[tisco_pri_mod_230607]F8:174", 8
grp.OPCItems.AddItem "[tisco_pri_mod_230607]F8:173", 9
'FOR RO C SALT PASSAGE
grp.OPCItems.AddItem "[tisco_pri_mod_230607]F8:184", 10
grp.OPCItems.AddItem "[tisco_pri_mod_230607]F8:183", 11
'FOR MB pH
grp.OPCItems.AddItem "[tisco_pri_mod_230607]F8:38", 12
'FOR MB Conductivity
grp.OPCItems.AddItem "[tisco_pri_mod_230607]F8:09", 13
'FOR ORP
grp.OPCItems.AddItem "[tisco_pri_mod_230607]F8:81", 14
'For Access DataBase Connectivity
Set Cn = New ADODB.Connection
Set Rst = New ADODB.Recordset
Set TempRst = New ADODB.Recordset
Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\PLCDATA.MDB;Persist Security Info=False"
Cn.BeginTrans
Cn.Execute "Delete From TagValue Where ValDate<=#" & Format(Now - 100, "dd-MMM-yyyy") & "#"
Cn.CommitTrans
grp.IsActive = True
grp.IsSubscribed = True
DTPFTime.Value = "06:00:00 AM"
DTPToTime.Value = "06:00:00 PM"
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim num As Integer
num = MsgBox("Are you sure want to close?.", vbInformation + vbYesNo, "PLC Report.")
If num = vbYes Then
Unload Me
Else
Cancel = 1
Exit Sub
End If
End Sub
Private Sub grp_DataChange(ByVal TransactionID As Long, ByVal NumItems As Long, ClientHandles() As Long, ItemValues() As Variant, Qualities() As Long, TimeStamps() As Date)
'''For i = 1 To NumItems
'''
''' If ClientHandles(i) = 1 Then
''' MsgBox grp.OPCItems(1).Value
''' grp.OPCItems(1).Write (0)
''' End If
'''
''' If ClientHandles(i) = 2 Then
'''
''' End If
'''
'''Next
End Sub
Private Sub SaveDataintoExcel()
On Error GoTo ErrorHandler
Dim iR As Long
Dim iC As Long
Dim iCol As Long
Dim FromDate As String, ToDate As String
Dim xlApp As New Excel.Application
Dim xlBook As New Excel.Workbook
Dim xlSheet As New Excel.Worksheet
If txtFileName = "" And OptSave.Value = True Then
MsgBox "Enter Filename to save.", vbExclamation, "Information !"
Exit Sub
End If
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.ActiveSheet
iCol = 1
FromDate = Format(DTPFromDate.Value, "dd-MMM-yyyy") & Space(3) & Format(DTPFTime.Value, "HH:MM") & "hr"
ToDate = Format(DTPToDate.Value, "dd-MMM-yyyy") & Space(3) & Format(DTPToTime.Value, "HH:MM") & "hr"
Set xlSheet = xlApp.ActiveSheet
xlSheet.Cells(1, 2) = "PLC Report For " & "(" & StrName & ")"
xlSheet.Cells(1, 2).Font.Bold = True
xlSheet.Cells(2, 2) = FromDate & " To " & ToDate
xlSheet.Cells(2, 2).Font.Bold = True
xlSheet.Cells(3, 2) = "----------------------------------------------------------------------------------------------"
xlSheet.Cells(4, 2) = "Date"
xlSheet.Cells(4, 2).Font.Bold = True
xlSheet.Cells(4, 4) = "Time(HR:Min)"
xlSheet.Cells(4, 4).Font.Bold = True
xlSheet.Cells(4, 6) = StrName
xlSheet.Cells(4, 6).Font.Bold = True
xlSheet.Cells(5, 2) = "----------------------------------------------------------------------------------------------"
Set Rst = Cn.Execute(StrRepQuery)
iR = 6
Do While Rst.EOF = False
xlSheet.Cells(iR, 2) = Format(Rst!ValDate, "dd-MMM-yyyy")
xlSheet.Cells(iR, 4) = Format(Rst!ValTime, "HH:MM")
xlSheet.Cells(iR, 6) = Rst!TagValue
iR = iR + 1
Rst.MoveNext
Loop
xlSheet.Cells(iR + 1, 2) = "----------------------------------------------------------------------------------------------"
For iC = 1 To iCol
xlSheet.Columns(iC).EntireColumn.AutoFit
Next
xlApp.Visible = True
If OptSave.Value = True Then
xlApp.ActiveWorkbook.SaveAs txtFileName.Text
txtFileName.Text = ""
Else
xlBook.Close
End If
Exit Sub
ErrorHandler:
MsgBox "Error"
txtFileName.Text = ""
Exit Sub
End Sub
Private Sub Timer1_Timer()
On Error GoTo ErrorHandler
Dim i, j As Integer
Dim ROANum1, ROANum2, ROANum3 As Double
Dim num As Double
num = 0
If Format(Now, "HH:MM:SS") = Format(Now, "HH:00:00") Or Format(Now, "HH:MM:SS") = Format(Now, "HH:10:00") Or Format(Now, "HH:MM:SS") = Format(Now, "HH:20:00") Or Format(Now, "HH:MM:SS") = Format(Now, "HH:30:00") Or Format(Now, "HH:MM:SS") = Format(Now, "HH:40:00") Or Format(Now, "HH:MM:SS") = Format(Now, "HH:50:00") Then
For i = 1 To 14
Cn.BeginTrans
Set TempRst = Cn.Execute("Select Max(UniqueID) as UID from Tagvalue")
If Not IsNull(TempRst!UID) Then
num = Val(TempRst!UID) + 1
Else
num = 1
End If
StrQuery = "insert into Tagvalue(UniqueID,ParentID,TagValue,ValDate,ValTime) values("
If i >= 1 And i < 6 Then
''StrQuery1 = "" & num & "," & i & "," & grp.OPCItems(i).Value & ",'" & Format(Now, "dd-MMM-yyyy") & "','" & Format(Now, "HH:NN:SS") & "')"
StrQuery1 = "" & num & "," & i & "," & grp.OPCItems(i).Value & ",'" & Now & "','" & Format(Now, "HH:NN:SS") & "')"
ElseIf i = 7 Then
ROANum1 = grp.OPCItems(i - 1).Value
ROANum2 = grp.OPCItems(i).Value
ROANum3 = (ROANum1 / ROANum2) * 100
''StrQuery1 = "" & num & "," & (i - 1) & "," & ROANum3 & ",'" & Format(Now, "dd-MMM-yyyy") & "','" & Format(Now, "HH:NN:SS") & "')"
StrQuery1 = "" & num & "," & (i - 1) & "," & ROANum3 & ",'" & Now & "','" & Format(Now, "HH:NN:SS") & "')"
ElseIf i = 9 Then
ROANum1 = grp.OPCItems(i - 1).Value
ROANum2 = grp.OPCItems(i).Value
ROANum3 = (ROANum1 / ROANum2) * 100
''StrQuery1 = "" & num & "," & (i - 2) & "," & ROANum3 & ",'" & Format(Now, "dd-MMM-yyyy") & "','" & Format(Now, "HH:NN:SS") & "')"
StrQuery1 = "" & num & "," & (i - 2) & "," & ROANum3 & ",'" & Now & "','" & Format(Now, "HH:NN:SS") & "')"
ElseIf i = 11 Then
ROANum1 = grp.OPCItems(i - 1).Value
ROANum2 = grp.OPCItems(i).Value
ROANum3 = (ROANum1 / ROANum2) * 100
''StrQuery1 = "" & num & "," & (i - 3) & "," & ROANum3 & ",'" & Format(Now, "dd-MMM-yyyy") & "','" & Format(Now, "HH:NN:SS") & "')"
StrQuery1 = "" & num & "," & (i - 3) & "," & ROANum3 & ",'" & Now & "','" & Format(Now, "HH:NN:SS") & "')"
ElseIf i >= 12 Then
''StrQuery1 = "" & num & "," & (i - 3) & "," & grp.OPCItems(i).Value & ",'" & Format(Now, "dd-MMM-yyyy") & "','" & Format(Now, "HH:NN:SS") & "')"
StrQuery1 = "" & num & "," & (i - 3) & "," & grp.OPCItems(i).Value & ",'" & Now & "','" & Format(Now, "HH:NN:SS") & "')"
Else
StrQuery1 = ""
End If
If StrQuery1 <> "" Then
StrQuery = StrQuery & StrQuery1
Cn.Execute (StrQuery)
End If
Cn.CommitTrans
Next
End If
Exit Sub
ErrorHandler:
Exit Sub
End Sub
Kindly suggest me the proper way and how to overcome the situation.
KK
|
|
|
|
|
|
Hi, I'm working on a small events project that has three columns one is for the event title one for the time and one for the date. I'm trying to check the second column against a label with the current time in the correct format for each event entered into its column. This is the code I have been working on but I can't seem to work it out right.
Private Function checkExistings()
For Each item In ListView1.Items
If item = lblDisplayTime.Text Then
End If
Next
End Function
Any help with this situation would be really appreciated
Many thanks
Pete
|
|
|
|
|
This sounds like a design issue where you want to validate the content of a field and inform the user. There are various validation frame works, depending on the UI platform you are working with.
Or you could put a label on your UI and populate it with an error message, or you could pop a messagebox and get in the users face or you could wait until the user has completed the entry and tell him each mistake made if there are multiple entries.
Some idea what UI you are using would refine the answer somewhat!
Never underestimate the power of human stupidity
RAH
|
|
|
|
|
I hope you can help me.
Let me explain then.
I have three fields in this form. First is for a category, the second one is the subcategory (should be based on the first one), and the third one is the type (based on these previous two). Yet, there is also a fourth field, since we are talking about a incident form, that is the assignment group. Based on selected options on the first, second and third fields, the fourth (group) field is automatically populated with the destination group.
Today, I have this form only with blank fields. I can type anything I want on them. If the category, sub category, type, and group exists in the system, it will be accepted, the form will be submitted, and the incident will be created successfully. Otherwise, the incident will have missing fields or will be ambiguously created, if there is a typo or if there is any different word that is not in the system.
So, I need something like a dropdown menu in each first, second and third fields, and the fourth field must be displayed automatically based on the combined selection of these first three. Are you following me? Hope so!
Also, if possible, and preferably because it will be better for future updates, I wish to get these fields populated based on a external txt or a excel file, or else, if I incorporate these entries on this vbscript, it will become huge and maybe heavy.
Finally, each category (1st field) entry (in the excel/txt) should be associated to a ID. So should be the subcategory (2nd field), and the type (3rd field). Which means, a category name is displayed, but behind there is a ID associated, and when submitting the form, the ID is the one that will be sent to the system (hope I am being clear). So this information Category and ID, for e.g, will be available and will be collected by the form, from to the external file.
So, below is a video showing a working drop down menu incident form submition, just the way I am looking for. The file is in SWF (flash format), so you can open it with internet explorer or with flash player.
http://files.engineering.com/getfile.aspx?folder=9...
The actual and working VBscript is also available on the link below.
http://files.engineering.com/getfile.aspx?folder=2...
Thanks for all your help.
Best regards!
|
|
|
|
|
I have the following code which works on windows 7 but when I run my app on windows 8 I just get a black box. I am using VB6
and have seen several capture submissions here but they all do the same thing (or at least the several I have tried.
Here is my code
Public Function CaptureWindow(ByVal hWndSrc As Long, ByVal Client As Boolean, ByVal LeftSrc As Long, ByVal TopSrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc As Long) As Picture
Dim hDCMemory As Long
Dim hBmp As Long
Dim hBmpPrev As Long
Dim hDCSrc As Long
Dim hPal As Long
Dim hPalPrev As Long
Dim RasterCapsScrn As Long
Dim HasPaletteScrn As Long
Dim PaletteSizeScrn As Long
Dim LogPal As LOGPALETTE
On Error Resume Next
If Client Then
hDCSrc = GetDC(hWndSrc)
Else
hDCSrc = GetWindowDC(hWndSrc)
End If
hDCMemory = CreateCompatibleDC(hDCSrc)
hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc)
hBmpPrev = SelectObject(hDCMemory, hBmp)
RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS)
HasPaletteScrn = RasterCapsScrn And RC_PALETTE
PaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE)
If HasPaletteScrn And (PaletteSizeScrn = 256) Then
LogPal.palVersion = &H300
LogPal.palNumEntries = 256
GetSystemPaletteEntries hDCSrc, 0, 256, LogPal.palPalEntry(0)
hPal = CreatePalette(LogPal)
hPalPrev = SelectPalette(hDCMemory, hPal, 0)
RealizePalette hDCMemory
End If
BitBlt hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, LeftSrc, TopSrc, vbSrcCopy
hBmp = SelectObject(hDCMemory, hBmpPrev)
If HasPaletteScrn And (PaletteSizeScrn = 256) Then
hPal = SelectPalette(hDCMemory, hPalPrev, 0)
End If
DeleteDC hDCMemory
ReleaseDC hWndSrc, hDCSrc
Set CaptureWindow = CreateBitmapPicture(hBmp, hPal)
End Function
Any help in changing or making it work on windows 7 & 8 is much appreciated
|
|
|
|
|
gwittlock wrote: I am using VB6
VB6 went out of support years ago, you should upgrade to VB.NET.
|
|
|
|
|
Thanks for your response. I agree with upgrading to .NET but that is not always possible when you have several projects with millions of lines of code.
Not everyone has the luxury or rewriting or upgrading all their code. I was asking if there was a solution to a very specific problem.
|
|
|
|
|
gwittlock wrote: I agree with upgrading to .NET but that is not always possible
Very true, but if you cannot or will not upgrade then you are going to have problems running something as old as VB6, especially on the newer versions of Windows.
|
|
|
|
|
I understand that. But wouldn't that be the answer to every question posted in this group? This group is for VB. There is another group for .net correct?
|
|
|
|
|
No, this forum is mostly for VB.NET, most people have long ago given up VB6, for the reasons I mentioned.
|
|
|
|
|
That would be my mistake then.
|
|
|
|
|
Here's a simple suggestion: rewrite the above code in VB.NET and see what the results are.
|
|
|
|
|
You wouldn't do it that way at all in .Net....
Kris
|
|
|
|
|
Well obviously. But that is not what the issue is about.
|
|
|
|
|
gwittlock wrote: This group is for VB
No VB6 is not recognised here as a viable product, this forum is targeted at VB.net. I can only thank the great Ghu I don't have your job! My sincere sympathies.
While most of the people supporting here probably have VB6 back in the past all of them have moved on so help is going to be very limited. It is well past the time for a rewrite, it is no longer a luxury it is critical.
Never underestimate the power of human stupidity
RAH
|
|
|
|
|
My mistake then about this group.
|
|
|
|
|
The problem you're going to have asking questions about VB6 is that very few people still have it installed to test the code and come up with a solution! This is going to be true at ANY forum, unless it's specifically dedicated to VB6.
|
|
|
|
|
OK OK! I get it! Don't ask questions. Done and Done.
|
|
|
|
|
There's nothing wrong with asking questions. But you need to understand that using a programming language that is years out of date is going to be difficult for people to answer. Also, that the later versions of Windows use features that VB6 was never designed to handle.
|
|
|
|
|
I understand about it being out of date. I also know there are a lot of people still programming in VB6. When a whole product works except for 1 feature it is difficult to justify the cost of totally re writing an app.
I feel like I asked a simple question just to get bashed because of the language. If people do not have an answer why be little someone for asking a question.
|
|
|
|
|
gwittlock wrote: why be little someone for asking a question.
No one has belittled you. We are just trying to get you to understand that VB6 is so long out of support that almost no one (particularly on this forum) uses it any more. The problem you are seeing may well be due to the fact that you are trying to use very old libraries and code on a much later OS which uses many new features. I have given you one suggestion to try and isolate whether the problem is definitely due to VB6, and you could save some time by trying it.
|
|
|
|
|
General 
News 
Suggestion 
Question 
Bug 
Answer 
Joke 
Praise 
Rant 
Admin 
Submit an article or tip
