Avete voglia di giocare interfacciandovi con un modem GSM collegato via RS232 e registrare gli sms in un Database Access?

Il nostro Form (form frmSendSMS) deve contenere:
textbox - proprietà Name = txtTestSms (conterrà il testo del messaggio)
taxtbox - proprietà Name = txtNumGSM (num. cellulare del destinatario del messaggio)
CommandButton - proprietà Name = btSendSMS (invia il messaggio di testo)
CommandButton - proprietà Name = DelAll (Elimina SMS dalla SIM)
MSComm - proprietà Name = MSComSMS

Settiamo come segue le proprietà dell'oggetto MSComSMS (le altre proprietà lasciarle con i valori di default):
CommPort = 1
Settings = 9600,n,8,1
DTREnable = True
Handshaking = 0 - comNone
InputMode = 0 - ComInputModeText
NullDiscart = False
RTSEnable = True

Inseriamo un modulo --> mdlGlobal.bas
codice:
Option Explicit

Global DB As Database
Global pathdb As String
Global r As Integer

'--------------------------------------------------------------
'Costanti per identificare l'indice dell'array restituito dalla
'funzione Split
Public Const COMMAND_SM = 0
Public Const CS = 1
Public Const BLANK = 2
Public Const DATACONSEGNA = 3
Public Const INVIO = 4
Public Const RECEIVE = 5
'---------------------------------------------------------------
'---------------------------------------------------------------
'DICHIARAZIONE API ------------------------------------------------
Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
'------------------------------------------------------------------

Public Sub apri_database(NomeOggetto As Database, NomeDatabase As String)
  On Error Resume Next
  pathdb = App.Path & "\Dati\"
  Set NomeOggetto = Workspaces(0).OpenDatabase(pathdb + NomeDatabase, False, False, ";pwd=miapasswordDB")
  If Err.Number <> 0 Then
    r = MsgBox("Ci sono dei problemi con gli archivi: il programma proverà a recuperarne lo stato!", vbCritical, "Diagnostica Database")
    On Error Resume Next
  End If
On Error GoTo 0
End Sub
-----------------------------------------------------------------------------------

codice per gli oggetti nel form:
Private Sub Form_Load()
  Call apri_database(DB, "MioDB.mdb")
End Sub
-----------------------------------------------------------------------------------
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  DB.Close
End Sub
-----------------------------------------------------------------------------------
Private Sub MSComSMS_OnComm()
  Dim sRisp As String
  Dim sCampo As String
  Dim iMyInd As Integer
  Dim iMyPos As Integer
  Dim lNumSmsRv As Long
  Dim arrSMSRv() As String
  Dim rsSMSRv As Recordset
  Dim sSimManut As String
  Dim dDataInvioSms As Date 'Data ed Ora Invio
  Dim dDataConsegnaSms As Date   'Data ed Ora di consegna
   
  Select Case MSComSMS.CommEvent
    Case comEvReceive
     
      sRisp = MSComSMS.Input
       Debug.Print "ARRIVATO --> " & sRisp
      txtRicezione = txtRicezione & sRisp
      txtRicezione.SelLength = Len(txtRicezione)
      If InStr(UCase(sRisp), "RING") Then
        MSComSMS.Output = "ath0" + Chr(13)
        Call Sleep(3000)
        MSComSMS.Output = "AT+CPBR=1,1" + Chr(13)
        Call Sleep(1000)
      Exit Sub
      End If
     
      'se il messaggio è arrivato al destinatario riceverò il comando "+CMTI: "MT", 4"
      If InStr(sRisp, """" & "MT" & """" & ",") Then
        MsgBox sRisp
          If InStr(sRisp, ",") Then
            iMyPos = InStr(sRisp, ",")
            If iMyPos <> 0 Then
              lNumSmsRv = Mid(sRisp, iMyPos + 1)
              MsgBox "Posizione in memoria di sms ricevuto: " & lNumSmsRv
              sComando = "AT+CMGR="
              MSComSMS.Output = sComando & lNumSmsRv & Chr(13)
              Call Sleep(2500)
              sRisp = MSComSMS.Input
            End If
          End If
      End If

      Debug.Print sRisp
      Select Case sComando
        Case "AT+CSQ" 'Comando per testare portante del segnale
          sRisp = Trim(Mid(sRisp, InStr(1, sRisp, ":") + 1))
          If InStr(1, sRisp, ",") <> 0 Then
            If Left(sRisp, InStr(1, sRisp, ",") - 1) >= 7 Then
                sComando = "AT+CMGF=1"
                MSComSMS.Output = sComando & Chr(13)
                Call Sleep(1000)
            Else
              MsgBox "SMS non inviato! Segnale insufficiente.", vbInformation, "Invio SMS fallito"
              Exit Sub
            End If
          End If
       
        Case "AT+CMGF=1"  'comando per trasmettere in formato 'Testo'
          sComando = "AT+CMGS="
          MSComSMS.Output = sComando & txtNumGSM.Text & Chr(13)
          Call Sleep(1000)
      
        Case "AT+CMGS="   'comando per inviare sms
          If InStr(sRisp, ">") Then
            MSComSMS.Output = txtTestSms.Text & Chr(26) & Chr(13)
            Call Sleep(1000)
          End If
       
        Case "AT+CMGD="
          If InStr(1, sRisp, "OK") Then
            lblNumSms = iNumDelSMS
          End If
         
        Case "AT+CMGR="
        'Leggo SMS ricevuto
        arrSMSRv() = Split(sRisp, ",", , vbTextCompare)
      
      End Select
    Case Else
      Debug.Print MSComSMS.CommEvent
  End Select
 
End Sub
-----------------------------------------------------------------------------------
Private Sub btDelAll_Click()
Dim i As Integer
  sComando = "AT+CMGD="
  If MSComSMS.PortOpen = False Then MSComSMS.PortOpen = True
  For i = 1 To 20
    MSComSMS.Output = "AT+CMGD=" & i & Chr(13)
    iNumDelSMS = i
    Call Sleep(3000)
    DoEvents
  Next i
End Sub
-----------------------------------------------------------------------------------
Private Sub btSendSMS_Click()
 
  If MSComSMS.PortOpen = False Then
    MSComSMS.PortOpen = True
  End If
  sComando = "AT+CNMI = 1,1"
  MSComSMS.Output = sComando + Chr(13)
  Call Sleep(2000)
  sComando = "AT+CSQ"
  MSComSMS.Output = sComando + Chr(13)
  Call Sleep(1000)
End Sub
-----------------------------------------------------------------------------------