the code is to get data from a microcontroller or any device from serial device using serial port,so i am having problem with port opening and getting data,am having this problem for last 20 days please kindly help me at the earliest :)
Private Sub Command1_Click()
MsgBox ("The port is open " & MSComm1.PortOpen)
If (MSComm1.PortOpen = False) Then
MSComm1.PortOpen = True
End If
Command1.Enabled = False
Command2.Enabled = True
End Sub
Private Sub Command2_Click()
If (MSComm1.PortOpen = True) Then
MSComm1.PortOpen = False
End If
Command1.Enabled = True
Command2.Enabled = False
End Sub
Private Sub Form_Load()
With MSComm1
.CommPort = 1
.RThreshold = 1
.RTSEnable = True
.Settings = "9600,N,8,1"
.InputLen = 127
.SThreshold = 1
End With
End Sub
Private Sub Form_Unload(Cancel As Integer)
If (MSComm1.PortOpen = True) Then
MSComm1.PortOpen = False
End If
End Sub
Private Sub MSComm1_OnComm()
Dim Buffer As String
Select Case MSComm1.CommEvent
Case comEvReceive
'Text1.Text = " "
Buffer = MSComm1.Input
Text1.Text = Text1.Text & Buffer
End Select
End Sub!
Below is the image of interface which contains the MScomm control ,a text box , two command buttons for connecting and disconnecting :
'****** paste this in form'*********
Option Explicit
Dim Portnumber As Integer
Private Sub cmdClose_Click()
On Error GoTo handler
MSComm1.PortOpen = False
Shape1.FillColor = vbRed
cmdOpen.Enabled = True
txtRecieve.Text = ""
Exit Sub
handler: MsgBox Err.Description
End Sub
Private Sub cmdOpen_Click()
On Error GoTo handler
' Debug.Print cboComm.ItemData(cboComm.ListIndex)
portnumber = Mid(cboComm.Text, 4, (Len(cboComm.Text) - 3))
a = Mid(cboComm.Text, 4, (Len(cboComm.Text) - 3))
' If MSComm1.PortOpen = False Then
MSComm1.CommPort = portnumber
MSComm1.PortOpen = True
Shape1.FillColor = vbGreen
cmdOpen.Enabled = False
' End If
Exit Sub
handler: MsgBox Err.Description
End Sub
Private Sub Form_Load()
cboComm.Clear '*** cbo is for combobox
MSComm1.Settings = "9600,n,8,1"
ListComPorts
End Sub
Private Sub ListComPorts()
Dim i As Integer
cboComm.Clear
Static iData As Integer
iData = -1
For i = 1 To 16
If ComAvailable(i) Then
cboComm.AddItem (("COM") & i)
iData = iData + 1
cboComm.ItemData(iData) = i
End If
Next
cboComm.ListIndex = 0
' cmdGet.Enabled = False
End Sub
Private Sub MSComm1_OnComm()
Select Case MSComm1.CommEvent
Case comEvReceive
txtRecieve.Text = MSComm1.Input
Case Else
Debug.Print "Event: " & MSComm1.CommEvent
End Select
End Sub
'**************** End of form code **************
'*********** Now API code******************
'********** Paste in Module**************
Option Explicit
'*** API Declarations
Public Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'*** API Structures
Public Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
'***API Constants
Public Const FILE_SHARE_READ = &H1
Public Const FILE_SHARE_WRITE = &H2
Public Const OPEN_EXISTING = 3
Public Const FILE_ATTRIBUTE_NORMAL = &H80
'*** Create a Fuction to check whether COM exists or not. If exists return "true" otherwise "false"
Public Function ComAvailable(comnum As Integer) As Boolean
Dim hcom As Long
Dim ret As Long
Dim sec As SECURITY_ATTRIBUTES
hcom = CreateFile("\.\COM" & comnum & "", 0, FILE_SHARE_READ + FILE_SHARE_WRITE, sec, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
If hcom = -1 Then
ComAvailable = False
Else
ComAvailable = True
'*** close the CO MPort
ret = CloseHandle(hcom)
End If
End Function
''''''''*******End of module code********
I think this will help you.....