Activex

Tengo un ejemplo que es así:
Código fuente que permite hacer lo siguiente. Con un cable serial Rs232, se conecta 2 computadores y este programa permite enviar y recibir texto, además de archivos. Lo otro, permite además, en modo de recepción la comunicación con una balanza, y permite interactuar con ésta, obteniendo datos y enviando caracteres, retornos de carro, etc.
Este es un ejemplo por ahí te sirve.
Si quieres saber más o no estas conforme haceme otra pregunta que voy a tratar de ser más especifico.
ESTO EN UN FORM
Option Explicit
Public bDatosVálidos As Boolean
Public sPuerto As String
Public sBaudios As String
Public sParidad As String
Public sBitsCar As String
Public sBitsParada As String
Public nControlFlujo As HandshakeConstants ' entero
Public nModoLectura As InputModeConstants ' entero
Private Sub cmdPredeterminados_Click()
' Se actualizan los controles desde las variables
lstPuerto.Text = "COM2"
lstBaudios.Text = 9600
lstParidad.Text = "None - Ninguna"
lstBitsCar.Text = 8
lstBitsParada.Text = 1
lstControlFlujo.ListIndex = 0 ' Sin protocolo
lstModoLectura.ListIndex = 0 ' Modo texto
End Sub
Private Sub Form_Load()
ActualizarDatos True ' mostrar los valores actuales
bDatosVálidos = False
End Sub
Public Sub ActualizarDatos(ByVal bActualizar As Boolean)
If bActualizar Then
' Se actualizan los controles desde las variables
lstPuerto.Text = "COM" & sPuerto
lstBaudios.Text = sBaudios
lstParidad.Text = sParidad
lstBitsCar.Text = sBitsCar
lstBitsParada.Text = sBitsParada
lstControlFlujo.ListIndex = nControlFlujo
lstModoLectura.ListIndex = nModoLectura
Else
' Se actualizan las variables desde los controles
sPuerto = Mid(lstPuerto.Text, 4) ' COMn
sBaudios = lstBaudios.Text
sParidad = lstParidad.Text
sBitsCar = lstBitsCar.Text
sBitsParada = lstBitsParada.Text
nControlFlujo = lstControlFlujo.ListIndex
nModoLectura = lstModoLectura.ListIndex
End If
End Sub
Private Sub cmdAceptar_Click()
ActualizarDatos False ' actualizar variables
bDatosVálidos = True ' se pulsó el botón Aceptar
Hide
End Sub
Private Sub cmdCancelar_Click()
ActualizarDatos True ' recuperar los valores que había
bDatosVálidos = False ' se pulsó el botón Cancelar
Hide
End Sub
========================
ESTO ES EN OTRO FORM
Option Explicit
Private WithEvents PuertoCom As MSComm
Private sPuerto As String
Private sBaudios As String
Private sParidad As String
Private sBitsCar As String
Private sBitsParada As String
Private nControlFlujo As HandshakeConstants 'entero
Private nModoLectura As InputModeConstants 'entero
'Tamaño de las colas de recepción y de transmisión
Const COLARX As Integer = 4096
Const COLATX As Integer = 4096
Private Sub Form_Load()
' Crear un objeto MSComm
Set PuertoCom = New MSComm
' Habilitar/Inhabilitar controles
ConexionCortar.Enabled = False
cmdEnviar.Enabled = False
UtilsEnviarFichero.Enabled = False
Iniciar ' leer la configuración del registro de Windows
StatusBar1.SimpleText = "Preparado"
End Sub
Private Sub ConfigParams_Click()
If PuertoCom.PortOpen = True Then
MsgBox "Cierre primero la conexión"
Exit Sub
End If
' Visualizar en los controles los parámetros de comunicación
' actuales. Inicialmente fueron recuperados del registro
frmConfiguración.sPuerto = sPuerto
frmConfiguración.sBaudios = sBaudios
frmConfiguración.sParidad = sParidad
frmConfiguración.sBitsCar = sBitsCar
frmConfiguración.sBitsParada = sBitsParada
frmConfiguración.nControlFlujo = nControlFlujo
frmConfiguración.nModoLectura = nModoLectura
' Visualizar el formulario Configuración
frmConfiguración.Show vbModal, Me
' Si se pulsó el botón Aceptar ...
If frmConfiguración.bDatosVálidos = True Then
' Asignar los nuevos valores a las variables correspondientes
sPuerto = frmConfiguración.sPuerto
sBaudios = frmConfiguración.sBaudios
sParidad = frmConfiguración.sParidad
sBitsCar = frmConfiguración.sBitsCar
sBitsParada = frmConfiguración.sBitsParada
nControlFlujo = frmConfiguración.nControlFlujo
nModoLectura = frmConfiguración.nModoLectura
' Descargar el formulario
Unload frmConfiguración
' Establecer la conexión con los parámetros establecidos
If EstablecerConexion = True Then
' Habilitar el botón de Enviar
cmdEnviar.Enabled = True
End If
End If
End Sub
Private Sub ConexionEstablecer_Click()
' Si la conexión ya estaba establecida, la orden Establecer
' está inhabilitada
If EstablecerConexion = True Then
cmdEnviar.Enabled = True
End If
End Sub
Private Sub ConexionCortar_Click()
' Si la conexión está cerrada, la orden Cortar
' está inhabilitada
Terminar
CortarConexion
cmdEnviar.Enabled = False
End Sub
Private Sub cmdEnviar_Click()
' Enviar los datos que hay en la caja de transmisión
If txtTX.Text <> "" Then
EscribirCarsPuerto txtTX.Text
txtTX.Text = ""
txtTX.SetFocus
End If
End Sub
Private Sub UtilsEnviarFichero_Click()
On Error GoTo Salir
Dim str As String, nFichero As Integer
' Visualizar la caja de diálogo Abrir
dlgAbrir.ShowOpen
If dlgAbrir.FileName = "" Then Exit Sub
' Abrir el fichero para leer
nFichero = FreeFile
Open dlgAbrir.FileName For Input Access Read As #nFichero
' Leer la información del fichero
str = Input(LOF(nFichero), nFichero)
' Enviar los datos al puerto
PuertoCom.Output = str
' Cerrar el fichero
Close #nFichero
Exit Sub
Salir:
MsgBox Err.Description
End Sub
Private Sub ConexionSalir_Click()
If PuertoCom.PortOpen Then CortarConexion
Unload frmPpal
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim i As Integer
Terminar
' Recorrer la colección Forms y descargar todos los formularios
For i = Forms.Count - 1 To 0 Step -1
Unload Forms(i)
Next
End Sub
Private Sub AyudaAcercaDe_Click()
frmAcercaDe.Show
End Sub
' RESPONDER A LOS EVENTOS GENERADOS EN EL PUERTO
' ----------------------------------------------
Private Sub PuertoCom_OnComm()
Dim sEvento As String, sError As String, sRecibida As String
' Controlar cada evento o error escribiendo
' código en cada caso
Select Case PuertoCom.CommEvent
' Eventos
Case comEvCD
sEvento = "Cambio en la línea CD."
Case comEvCTS
sEvento = "Cambio en la línea CTS."
Case comEvDSR
sEvento = "Cambio en la línea DSR."
Case comEvRing
sEvento = "Cambio en el indicador de llamadas."
Case comEvReceive
sEvento = "Recibido(s) " & PuertoCom.RThreshold & _
" carácter/caracteres."
' Leer caracteres del puerto
If LeerCarsPuerto(sRecibida) > 0 Then
txtRX.Text = txtRX.Text & sRecibida
End If
Case comEvSend
sEvento = "Hay SThreshold = " & PuertoCom.SThreshold & _
" carácter/caracteres en el búfer de transmisión."
Case comEvEOF
sEvento = "Se ha encontrado un carácter EOF en la entrada."
' Errores
Case comBreak
sError = "Se ha recibido una interrupción."
Case comEventFrame
sError = "Error de trama."
Case comEventOverrun
sError = "Datos perdidos."
Case comEventRxOver
sError = "Desbordamiento del búfer de recepción."
Case comEventRxParity
sError = "Error de paridad."
Case comEventTxFull
sError = "Búfer de transmisión lleno."
Case comEventDCB
sError = "Error inesperado al recuperar el DCB."
End Select
If Not IsEmpty(sEvento) Then
StatusBar1.SimpleText = sEvento
ElseIf Not IsEmpty(sError) Then
Dim vr As VbMsgBoxResult
Beep
sError = sError & vbNewLine & "Aceptar para ignorar. " & _
"Cancelar para salir"
vr = MsgBox(sError, vbOKCancel + vbExclamation, App.Title)
If vr = vbCancel Then
' Cerrar el puerto
PuertoCom.PortOpen = False
ConexionEstablecer.Enabled = True
ConexionCortar.Enabled = False
UtilsEnviarFichero.Enabled = False
End If
End If
End Sub
' INTERFAZ DE COMUNICACIONES
' --------------------------
Private Sub Iniciar()
'No se verifica que los datos obtenidos sean buenos
sPuerto = GetSetting(App.Title, "MSComm", "Puerto", "2")
sBaudios = GetSetting(App.Title, "MSComm", "Baudios", "9600")
sBitsParada = GetSetting(App.Title, "MSComm", "BitsParada", "1")
sParidad = GetSetting(App.Title, "MSComm", "Paridad", "None - Ninguna")
sBitsCar = GetSetting(App.Title, "MSComm", "BitsCar", "8")
nControlFlujo = GetSetting(App.Title, "MSComm", "ControlFlujo", "0")
nModoLectura = GetSetting(App.Title, "MSComm", "ModoLectura", "0")
End Sub
Private Sub Terminar()
SaveSetting App. Title, "MSComm", "Puerto", sPuerto
SaveSetting App. Title, "MSComm", "Baudios", sBaudios
SaveSetting App. Title, "MSComm", "BitsParada", sBitsParada
SaveSetting App. Title, "MSComm", "Paridad", sParidad
SaveSetting App. Title, "MSComm", "BitsCar", sBitsCar
SaveSetting App. Title, "MSComm", "ControlFlujo", nControlFlujo
SaveSetting App. Title, "MSComm", "ModoLectura", nModoLectura
End Sub
Private Function EstablecerConexion() As Boolean
On Error Resume Next
With PuertoCom
' Cerrar el control si estuviera abierto
If .PortOpen = True Then .PortOpen = False
' Especificar el puerto COM que se desea abrir
.CommPort = sPuerto ' número del puerto (1, 2, ...)
' Establecer el tamaño de las colas de recepción y transmisión
.InBufferSize = COLARX ' cola de recepción
.OutBufferSize = COLATX ' cola de transmisión
' Limpiar las colas Rx y Tx
.InBufferCount = 0
.OutBufferCount = 0
' Establecer los parámetros de la comunicación
Dim sSettings As String
' Baudios, paridad, número de bits de datos y de parada
' Longitud del bit de paro:
sSettings = sBaudios & "," & Left(sParidad, 1) & "," & _
sBitsCar & "," & sBitsParada
.Settings = sSettings
' Establecer el control de flujo
.Handshaking = nControlFlujo
' Cómo se leerán los datos del puerto
.InputMode = nModoLectura
' Caracteres que puede admitir el buffer de transmisión antes
' de que el control genere el evento OnComm.
' Su valor predeterminado es 0
.SThreshold = 1
' Caracteres que se van recibir antes de que el control genere
' el evento OnComm. Su valor predeterminado es 0.
.RThreshold = 1
' Abrir el puerto de comunicaciones
.PortOpen = True
If .PortOpen = False Then
' Error al abrir el puerto (verifique la configuración)
Beep
MsgBox "Error: No se puede abrir el puerto COM" & _
sPuerto, vbOKOnly + vbCritical, App.Title
If sBitsParada > "1" Then
MsgBox _
"1 bit en cualquier longitud de carácter, o bien " & _
vbCrLf & "1.5 bits en longitud de carácter 5, y " & _
vbCrLf & "2 bits en longitud de carácter 6 a 8", _
vbOKOnly + vbInformation, App.Title
End If
EstablecerConexion = False
Exit Function
End If
End With
' El puerto se abrió con éxito
EstablecerConexion = True
StatusBar1.SimpleText = "Puerto de comunicaciones abierto"
' Habilitar/Inhabilitar órdenes de ls menús
ConexionEstablecer.Enabled = False
ConexionCortar.Enabled = True
UtilsEnviarFichero.Enabled = True
End Function
Private Function LeerCarsPuerto(ByRef sRecibida As String) As Long
sRecibida = PuertoCom.Input
LeerCarsPuerto = Len(sRecibida)
End Function
Private Function EscribirCarsPuerto(str As String) As Boolean
PuertoCom.Output = str
EscribirCarsPuerto = True
End Function
Private Function CortarConexion() As Boolean
If ConexionCortar.Enabled = True Then
Dim bTiempoSobrepasado As Boolean, Tiempo As Long
' Establecer un periodo de 10 segundos a partir de la hora
' actual antes de cerrar el puerto, por seguridad
bTiempoSobrepasado = False
Tiempo = Now
StatusBar1.SimpleText = "Cerrando la conexión..."
While PuertoCom.OutBufferCount > 0
' Permitir procesar mensajes pendientes
DoEvents
If DateDiff("s", Now, Tiempo) > 10 Or _
bTiempoSobrepasado = True Then
Dim vr As VbMsgBoxResult
vr = MsgBox("Datos no enviados", vbAbortRetryIgnore, _
App.Title)
Select Case vr
' Intentar enviar los datos durante otros 10 segundos
Case vbRetry
Tiempo = Now
' Ignorar el tiempo límite
Case vbIgnore
bTiempoSobrepasado = True
Case vbAbort
StatusBar1.SimpleText = ""
CortarConexion = False
Exit Function
End Select
End If
Wend
' Tx vacío. Cerrar el puerto.
PuertoCom.PortOpen = False
ConexionEstablecer.Enabled = True
ConexionCortar.Enabled = False
UtilsEnviarFichero.Enabled = False
End If
StatusBar1.SimpleText = "Conexión concluida"
CortarConexion = True
End Function
MI EMAIL [email protected] es si quieres que te pase el programa completo
(Esto lo saque de la web hace tiempo)
Avisame por favor
El ejemplo funciona perfectamente, lo he probado entre 2 computadores y lo uso actualmente para capturar datos de una balanza electrónica.