this my code.
hope help u


Option Explicit

Dim buffer$

Dim aText As String
Dim bText As Long
Dim cText As String
Dim dText As Long
Dim Location As String

Dim AKAUN As String, TARIKH As String, newMsg As String
Dim MASA As String, KWJ As String

Private Sub CmdRead_Click()
Dim Counter As String
Counter = 0

Do
Text9.Text = Counter
Counter = Counter + 1

'Wait incomming sms
Text3.Text = Text3.Text & vbCr & "Wait Message" + Chr(34) + Chr$(13)
Do
DoEvents
buffer$ = buffer$ & MSComm1.Input
Loop Until InStr(buffer$, "+CMTI: ""ME""")
Text1.Text = Text1.Text & vbCr & buffer$
buffer$ = ""

buffer$ = buffer$ & MSComm1.Input
Text1.Text = Text1.Text & vbCr & buffer$
buffer$ = ""

aText = Text1.Text
bText = InStr(aText, "+CMTI: ""ME""")

newMsg = Text1.Text
newMsg = Right(newMsg, Len(newMsg) - bText)

newMsg = Right(newMsg, Len(newMsg) - 11)

Location = Left(newMsg, 2)

'Location mesage storage
Text4.Text = Location

Text3.Text = Text3.Text & vbCr & "Read Message" + Chr(34) + Chr$(13)

'Read sms
MSComm1.Output = "AT+CMGR=" + Location + Chr(13)

Do
DoEvents
buffer$ = buffer$ & MSComm1.Input
Loop Until InStr(buffer$, "OK")
Text1.Text = Text1.Text & vbCr & buffer$
Text2.Text = buffer$
buffer$ = ""

'Set for Separate Message
Text3.Text = Text3.Text & vbCr & "Separate Message" + Chr(34) + Chr$(13)

cText = Text2.Text
dText = InStr(cText, """REC UNREAD""")

newMsg = Text2.Text
newMsg = Right(newMsg, Len(newMsg) - dText)

newMsg = Right(newMsg, Len(newMsg) - 14)

AKAUN = Left(newMsg, 11)
newMsg = Right(newMsg, Len(newMsg) - 17)

TARIKH = Left(newMsg, 8)
newMsg = Right(newMsg, Len(newMsg) - 9)

MASA = Left(newMsg, 8)
newMsg = Right(newMsg, Len(newMsg) - 12)

KWJ = Left(newMsg, 11)

Text5.Text = AKAUN 'phone no
Text6.Text = TARIKH 'Date send
Text7.Text = MASA 'Time send
Text8.Text = KWJ 'message

Text3.Text = Text3.Text & vbCr & "Delete Message" + Chr(34) + Chr$(13)

MSComm1.Output = "AT+CMGD=" + Location + Chr(13)

Do
DoEvents
buffer$ = buffer$ & MSComm1.Input
Loop Until InStr(buffer$, "OK")
Text1.Text = Text1.Text & vbCr & buffer$
buffer$ = ""
Text3.Text = Text3.Text & vbCr & "" + Chr(34) + Chr$(13)
Text1.Text = ""
Text2.Text = ""

Counter = Counter - 1 'Set for loop forever

Loop Until Counter > 3

MSComm1.PortOpen = False
End Sub

Private Sub CmdSetting_Click()

'Set interation of comunication
Text3.Text = Text3.Text & vbCr & "Start Setting" + Chr(34) + Chr$(13)

MSComm1.Output = "AT+CNMI=2,1,2,0,0" + Chr(13)

Do
DoEvents
buffer$ = buffer$ & MSComm1.Input
Loop Until InStr(buffer$, "OK")
Text1.Text = Text1.Text & vbCr & buffer$
buffer$ = ""

'Set message storage
Text3.Text = Text3.Text & vbCr & " Setting " + Chr(34) + Chr$(13)

MSComm1.Output = "AT+CPMS=""ME"",""SM"",""ME""" + Chr(13)

Do
DoEvents
buffer$ = buffer$ & MSComm1.Input
Loop Until InStr(buffer$, "OK")
Text1.Text = Text1.Text & vbCr & buffer$
buffer$ = ""

'Set SMS format to Text
MSComm1.Output = "AT+CMGF=1" + Chr(13)

Do
DoEvents
buffer$ = buffer$ & MSComm1.Input
Loop Until InStr(buffer$, "OK")
Text1.Text = Text1.Text & vbCr & buffer$
buffer$ = ""

Text3.Text = Text3.Text & vbCr & "End Setting" + Chr(34) + Chr$(13)
Text1.Text = ""

End Sub

Private Sub Form_Load()

MSComm1.CommPort = 1
MSComm1.Settings = "57600,n,8,1"
MSComm1.PortOpen = True
MSComm1.Handshaking = comNone

End Sub