I want to send long sms (more than 160 characters) from pc to mobile. I am using MSComm control in VB6. It works good with small messages but when my message exceeds 160 characters then it shows sending ok but message is not delivered.
With MSComm1
.CommPort = port
.Settings = "9600,N,8,1"
.Handshaking = comRTS
.RTSEnable = True
.DTREnable = True
.RThreshold = 1
.SThreshold = 1
.InputMode = comInputModeText
.InputLen = 0
.PortOpen = True 'must be the last
End With
'Send an 'AT' command to the phone
MSComm1.Output = "AT" & vbCrLf
Sleep 500
MSComm1.Output = "AT+CMGF=1" & vbCrLf 'This line can be removed if your modem will always be in Text Mode...
Sleep 500
MSComm1.Output = "AT+CMGS=" & Chr(34) & mnumber & Chr(34) & vbCrLf 'Replace this with your mobile Phone's No.
Sleep 1000
MSComm1.Output = TxtMessage.Text & Chr(26)
You cannot send a message that exceeds the 160 character limit.
When your phone receives a long message its actually receiving multiple messages and stitching them together, this is called Concatenated SMS.
To do this you would need to switch from Text Mode (how you are currently interacting with the device) to PDU mode; this enables you to manually set the SMS message header (UDH).
Within the UDH you can set a flag (IEI) indicating that the message is a concatenated SMS, the total number of parts and the current part number. You can then send multiple short messages and rely on the receiving end sticking them together.
Related
I am new to this. am not sure if anybody used game ranger before and I am trying to create something more simple.
client and server connection, the client connects to the server pc over the internet using the
playit.gg provided ip:port and it connects ok.
now I wonder if there is anything else needed for the game to detect other ips in-game multiplayer screen?.
I have a multi-connection server and IP vb6 source. simple using Winsock.
were you see the server:port is inputted from
.RemoteHost = "write-mechanical.at.playit.gg"
.RemotePort = "55224"
chat client side to connect
Option Explicit
Private Sub cmdConnect_Click()
'Check input.
txtServer.Text = Trim$(txtServer.Text)
txtPort.Text = Trim$(txtPort.Text)
txtNickname.Text = Trim$(txtNickname.Text)
If Len(txtServer.Text) = 0 Or Len(txtPort.Text) = 0 Or _
Len(txtNickname.Text) = 0 Then
MsgBox "Please fill in all fields!", vbCritical
Exit Sub
ElseIf Not IsNumeric(txtPort.Text) Then
MsgBox "Invalid port value!", vbCritical
Exit Sub
End If
'Done with that...
strMyNickname = txtNickname.Text
With frmChat.sckClient
.Close
bolRecon = False
.RemoteHost = txtServer.Text
.RemotePort = txtPort.Text
.Connect
End With
Me.Hide
frmChat.Show
AddStatusMessage frmChat.rtbChat, RGB(128, 128, 128), "> Connecting to " & txtServer.Text & ":" & txtPort.Text & "..."
End Sub
Private Sub txtPort_KeyPress(KeyAscii As Integer)
'Number only.
If Not IsNumeric(Chr$(KeyAscii)) And Not KeyAscii = 8 Then KeyAscii = 0
End Sub
and server-side to accept
With frmChat
.sckServer(0).Close
.sckServer(0).LocalPort = CInt(txtPort.Text)
.sckServer(0).Listen 'Opens the winsock control.
End With
Dim strNotify
Dim strPacket As String
Option Explicit
'JUST USED FOR FORM RESIZING.
Private Type RECT
rctLeft As Long
rctTop As Long
rctRight As Long
rctBottom As Long
End Type
'JUST USED FOR FORM RESIZING.
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
'JUST USED FOR FORM RESIZING.
Private udtMyRect As RECT
Private Sub sckServer_Close(Index As Integer)
sckServer(Index).Close
Dim strPacket As String
strPacket = "LEA" & Chr$(2) & udtUsers(Index).strNickname & Chr$(4)
SendGlobalData strPacket
AddUserEntersLeaves rtbChat, udtUsers(Index).strNickname, False
RemoveListItem lstUsers, udtUsers(Index).strNickname
With udtUsers(Index)
.strBuffer = vbNullString
.strIP = vbNullString
.strNickname = vbNullString
End With
End Sub
'A client is attempting to connect.
'----------------------------------
'Another computer is trying to connect to the server.
'Find a socket we can use to handle the connection.
'Then load a slot in the udtUsers() array for this user.
Private Sub sckServer_ConnectionRequest(Index As Integer, ByVal requestID As Long)
Dim intNext As Integer
intNext = ModChat.NextOpenSocket
If intNext > 0 Then
'Found a socket to use; accept connection.
sckServer(intNext).Accept requestID
'Check if there is a slot open for this connection
'in the users array.
If UBUsers < intNext Then
'There isn't, load one.
ReDim Preserve udtUsers(intNext) As CHAT_USER
End If
'(Re)set this client's info.
With udtUsers(intNext)
.strIP = sckServer(intNext).RemoteHostIP
.strNickname = vbNullString
End With
'We haven't received the user's nickname yet.
'That will happen in the DataArrival event :)
'Once it does, we will need to let everyone know that this person joined the room.
AddStatusMessage rtbChat, RGB(0, 0, 128), "> " & sckServer(intNext).RemoteHostIP & " connected!"
End If
End Sub
Private Sub sckServer_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim strData As String, strPackets() As String
Dim strTrunc As String, bolTrunc As Boolean
Dim lonLoop As Long, lonTruncStart As Long
Dim lonUB As Long
'Get the received data.
sckServer(Index).GetData strData, vbString, bytesTotal
With udtUsers(Index)
'Append it to the buffer.
.strBuffer = .strBuffer & strData
strData = vbNullString
'Check if the last byte is the packet delimiter (Chr$(4)).
'If it is, there are no truncated packets.
'If it isn't, the last packet got split up. >:(
If Right$(.strBuffer, 1) <> Chr$(4) Then
'Get all data to the right of the last Chr$(4) which is the truncated packet.
bolTrunc = True
'Find position of last packet delimiter.
lonTruncStart = InStrRev(.strBuffer, Chr$(4))
'Check if it was found.
If lonTruncStart > 0 Then
'Extract out the truncated part.
strTrunc = Mid$(.strBuffer, lonTruncStart + 1)
End If
End If
'We checked if the data was truncated.
'If it was, we put that part away for now and set the Truncated flag to TRUE (bolTrunc).
'Split up the data buffer into individual packets
'in case we received more than 1 at a time.
'Process them individually.
If InStr(1, .strBuffer, Chr$(4)) > 0 Then
strPackets() = Split(.strBuffer, Chr$(4))
'Now all of the individual packets are in strPackets().
'Loop through all of them.
lonUB = UBound(strPackets) 'Get number of packets.
'If the data is truncated, don't process the last one
'because it isn't complete.
If bolTrunc Then lonUB = lonUB - 1
'Start looping through all packets.
For lonLoop = 0 To lonUB
'Check length of packet.
'Each packet has a command/header,
'the packet must be at least that length.
'In this example, all headers are 3 bytes/characters long.
If Len(strPackets(lonLoop)) > 3 Then
'Look at the header and process the packet accordingly.
Select Case Left$(strPackets(lonLoop), 3)
'Packet is a chat message.
Case "MSG"
'Process message.
ParseChatMessage Index, strPackets(lonLoop)
'User is connecting (sending nickname).
Case "CON"
'Process connection.
ParseConnection Index, strPackets(lonLoop)
'Add your own here! :)
'Case "XXX"
'Do something.
'Case "YYY"
'Do something.
End Select
End If
Next lonLoop
End If
'We're done processing all packets.
Erase strPackets
'Now we can erase all the data we just processed from the buffer.
'Otherwise, it will just keep growing in size and the same data
'will be processed over and over (which might actually be kinda cool?).
.strBuffer = vbNullString
If bolTrunc Then
'Still have a piece of a packet left over because the data was truncated.
'Erase the buffer then put just the truncated part back in.
.strBuffer = strTrunc
End If
strTrunc = vbNullString
End With
End Sub
just a quote from my comment laying out what I want to do.
the server is in my computer running and they connect to me from
another house over the internet using the ip and port provided by
playitt.gg ok so now that i know they are connected to my machine via
the server app. now i want to know is will multiplayer games be able
to detect those ips even we got same game same version installed
My question is similar to but not the same to the one below,
Mark a mailitem as sent (VBA outlook)
Basically, something (AV, bug in Outlook or Exchange or both), has modified hundreds of incoming (external emails) to a particular user as drafts and now appear as unsent. This means the user cannot reply to these messages and the suggested alternative of copying and pasting looks very unprofessional and confusing to the user's clients. Thankfully whatever was causing it stopped but the damage is done.
I need some way to modify the PR_MESSAGE_FLAGS programmatically. I am comfortable with VB script, VBA, VB.Net and even C#/C++ but I am coming up empty for how to do it.
Should it matter, the server is Exchange 2013 and client is Outlook 2010 or 2016 (32 or 64bit). The entire mailbox has been exported to PST and can be worked on offline if that helps. :)
Based on Dmitry's answer, here is the code that clones the old messages and marks them as sent so they can be replied to.
Only concern with it is that it seems to be breaking Conversations.
Dim mysession
Sub doFixDrafts()
log " Starting scan!"
Set mysession = CreateObject("Redemption.RDOSession")
mysession.Logon
Const sRootFolder = "\\Mailbox\Inbox"
Set oRootFolder = mysession.getfolderfrompath(sRootFolder)
'Set oRootFolder = mysession.PickFolder
doCleanupFolder oRootFolder, sRootFolder
log "Scan complete!!"
End Sub
Sub doCleanupFolder(oFolder, sFolder)
Dim c: c = 0
Dim i: i = 0
Dim tc: tc = Format(oFolder.Items.Count, "0000")
'Get start timestamp so we can report in at regular intervals...
Dim st: st = Now()
log "Checking... " & sFolder
Dim aMsgIDs()
'Make a list of 'unsent' messages
For Each Item In oFolder.Items
i = i + 1
If Not Item.Sent Then
c = c + 1
msgID = Item.EntryID
ReDim Preserve aMsgIDs(1 To c)
aMsgIDs(c) = msgID
c = Format(c, "0000")
End If
'Give update for large folders...
ct = Now()
td = DateDiff("s", st, ct)
If td > 15 Then
log c & "/" & i & "/" & tc & " so far..."
st = ct
End If
DoEvents
Next
c = Format(c, "0000")
log c & "," & tc & "," & sFolder
'Fix the corrupt messages
For m = 1 To CInt(c)
Set badMsg = mysession.GetMessageFromID(aMsgIDs(m))
sSender = badMsg.Sender
sSubject = badMsg.Subject
dSentDate = badMsg.SentOn
Set newMsg = oFolder.Items.Add("IPM.Note")
newMsg.Sent = True
badMsg.CopyTo (newMsg)
newMsg.Save
badMsg.Delete
Dim a As String
a = Format(m, "0000") & "," & sSender & ","
a = a & Chr(34) & sSubject & Chr(34) & ","
a = a & Chr(34) & dSentDate & Chr(34)
log a
DoEvents
Next m
For Each Item In oFolder.Folders
doCleanupFolder Item, sFolder & "\" & Item.Name
Next
End Sub
Sub log(s As String)
d = Format(Now(), "yyyy-mm-dd hh:mm:ss")
t = d & " " & s
Debug.Print t
Const logfile = "c:\temp\fixdrafts.txt"
Open logfile For Append As #1
Print #1, t
Close #1
End Sub
The answer is still the same - on the low (Extended MAPI) level, sent/unsent status (MSGFLAG_UNSENT bit in the PR_MESSAGE_FLAGS property) can only be changed before the item is saved for the very first time.
Outlook Object Model is subject to the same limitation of course, and the only way to create an item in the sent state is to create a PostItem object - it is created in the sent state. You will then need to change the message class back to IPM.Note and remove the icon related properties to make sure the item looks right.
Redemption (I am its author) lets you change the item's state (RDOMail.Sent is read/write before the first call to Save).
It should be pretty easy to create copies of existing unsent messages in the sent state - loop through the problematic messages (it is better to avoid using "for each" if you will be creating new items in the same folder - your "for each" loop will start picking up new messages. Loop through the messages first and store their entry ids in a list or array), create new item using Redemption (RDOFolder.Items.Add), set the Sent property to true (RDOMail.Sent = true), open the problematic message by its entry ids (RDOSession.GetMessageFromID), copy the problematic message into the new message using RDOMail.CopyTo(AnotherRDOMailObject), call RDOMail.Save on the new message and RDOMail.Delete on the old message.
Right now i am developing a tool that will allow me to measure the delay between network connections using VB6 and a arduino UNO with ethernet shield.
Now i am facing some issues with the Server code (the VB6 program).
I have 2 winsocks with both different ports and they are both listening for the arduino client to connect. Now if i have only one active connection nothing goes wrong and everything works fine, but as soon as the second client connects the entire server starts going crazy. Suddenly it reports that the first client that connected lost it connection, so in short the server just doesn't want 2 clients connected at a time but i really do need it :/ What is going wrong?
I'll quickly explain what sertain command do that are send over the winsock to or from the server.
"SERVER_SLEEP" Is a command that the server sends to all clients that will tell them to enter a power saving mode.
"SERVER_REQUESTS_DATA" Is a command that the server sends to a specific client and forces the client to send information like Device name and firmware version.
"RESPOND_MESSAGE" Is a command that the server sends to all clients and the client is forced to respond to see if we still have an connection.
"DEVICE_NAME=" Is a command that the client sends to the server when it just connects, It is required before we show that we have an connection by putting it into the listbox. (after the = comes the device name)
"DEVICE_NAME_REP=" Is a command that the client sends to the server when the server requests information about the client, the reason i have 2 of them is because i couldn't reuse the previous one since then it would become way to complicated. (after the = comes the device name)
"DEVICE_FIRMWARE=" Is a command that the client sends to the server when the server requests information about the client. (after the = comes the device firmware version)
"DEVICE_OK=" Is a command that the client sends to the server when the server requests an answer to check if we still have an connection. (after the = comes the device name)
"DEVICE_REBOOTING" Is a command that the client sends to the server when it goes out of sleep mode (it goes out of that mode when the server comes back online again after it was closed) After the client send that message it immediately closes the connection again and the device is forced to reboot to make sure nothing goes wrong.
My code:
Dim DeviceIP1 As String
Dim DeviceIP2 As String
Dim UpdateListStatus As Integer
Private Sub Command1_Click()
MsgBox Socket1.State
MsgBox Socket2.State
End Sub
Private Sub Command3_Click()
If Dir(App.Path & "\TH.exe") <> "" Then 'Traceroute Helper application i wrote before, Works 100% and is not relevant for the issue i am facing
Shell App.Path & "\TH.exe " & DeviceIP, vbNormalFocus
Else
MsgBox "Missing file!" & vbNewLine & "File TH.exe is required for the requested operation!", vbCritical + vbSystemModal, "Missing file"
End If
End Sub
Private Sub Form_Load()
Socket1.Listen
Socket2.Listen
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim msg As VbMsgBoxResult
msg = MsgBox("Are you sure you want to exit?" & vbNewLine & "All the clients will be put into sleep mode.", vbYesNo + vbQuestion + vbSystemModal, "Quit")
If msg = vbYes Then
Form3.Show
Cancel = True
Form1.Visible = False
Else
Cancel = True
End If
End Sub
Private Sub List1_Click()
On Error GoTo errhandler
Dim ClientFound As Boolean
DeviceIP = Mid(List1.Text, InStr(List1.Text, "-") + 1)
DeviceIP = LTrim(DeviceIP)
DeviceIPLabel.Caption = "Device IP: " & DeviceIP
Form2.Show
If Socket1.RemoteHostIP = DeviceIP Then
Socket1.SendData ("SERVER_REQUESTS_DATA")
ElseIf Socket2.RemoteHostIP = DeviceIP Then
Socket2.SendData ("SERVER_REQUESTS_DATA")
End If
Exit Sub
errhandler:
If Err.Number = 40006 Then
MsgBox "Socket error!" & vbNewLine & "The requested device might be offline.", vbCritical + vbSystemModal, "Socket error"
Unload Form2
End If
End Sub
Private Sub UpdateList_Timer()
On Error Resume Next
If List1.ListCount > 0 Then
If UpdateListStatus = 0 Then
TempList.Clear
Socket1.SendData ("RESPOND_MESSAGE")
Socket2.SendData ("RESPOND_MESSAGE")
UpdateListStatus = 1
UpdateList.Interval = 5000
ElseIf UpdateListStatus = 1 Then
List1.Clear
For x = 0 To TempList.ListCount
List1.AddItem (TempList.List(x))
Next x
For X2 = 0 To List1.ListCount
If List1.List(X2) = "" Then 'Check if we have any items that are nothing
List1.RemoveItem (X2)
End If
Next X2
Label1.Caption = "Connected clients: " & List1.ListCount
UpdateListStatus = 0
UpdateList.Interval = 10000
End If
End If
End Sub
Private Sub Socket1_DataArrival(ByVal bytesTotal As Long)
On Error Resume Next
Dim TempString As String
Dim TempString2 As String
Dim position As Integer
Socket1.GetData TempString, vbString
position = InStr(1, TempString, "DEVICE_NAME=")
If position > 0 Then 'It is a device name command from a client
TempString2 = Mid(TempString, InStr(TempString, "=") + 1)
List1.AddItem (TempString2 + " - " + Socket1.RemoteHostIP)
Label1.Caption = "Connected clients: " & List1.ListCount
TempString2 = ""
End If
position = 0
position = InStr(1, TempString, "DEVICE_NAME_REP=")
If position > 0 Then 'It is a device name command from a client
TempString2 = Mid(TempString, InStr(TempString, "=") + 1)
DeviceNameLabel.Caption = "Device name: " & TempString2
TempString2 = ""
End If
position = 0
position = InStr(1, TempString, "DEVICE_FIRMWARE=")
If position > 0 Then 'It is a device firmware command from a client
TempString2 = Mid(TempString, InStr(TempString, "=") + 1)
DeviceFirmwareLabel.Caption = "Firmware version: " & TempString2
Unload Form2 'Since this is the last piece we will be receiving we can close this window
TempString2 = ""
End If
position = 0
position = InStr(1, TempString, "DEVICE_OK=")
If position > 0 Then 'It is a device respond command from a client
TempString2 = Mid(TempString, InStr(TempString, "=") + 1)
TempList.AddItem (TempString2 + " - " + Socket1.RemoteHostIP)
Label1.Caption = "Connected clients: " & List1.ListCount
TempString2 = ""
End If
position = 0
position = InStr(1, TempString, "DEVICE_REBOOTING")
If position > 0 Then 'It is a device respond command from a client
Socket1.Close
TempString2 = ""
End If
Text1.Text = Text1.Text & TempString & vbNewLine
TempString = ""
position = 0
TempString2 = ""
End Sub
Private Sub Socket2_DataArrival(ByVal bytesTotal As Long)
On Error Resume Next
Dim TempString As String
Dim TempString2 As String
Dim position As Integer
Socket2.GetData TempString, vbString
position = InStr(1, TempString, "DEVICE_NAME=")
If position > 0 Then 'It is a device name command from a client
TempString2 = Mid(TempString, InStr(TempString, "=") + 1)
List1.AddItem (TempString2 + " - " + Socket2.RemoteHostIP)
Label1.Caption = "Connected clients: " & List1.ListCount
TempString2 = ""
End If
position = 0
position = InStr(1, TempString, "DEVICE_NAME_REP=")
If position > 0 Then 'It is a device name command from a client
TempString2 = Mid(TempString, InStr(TempString, "=") + 1)
DeviceNameLabel.Caption = "Device name: " & TempString2
TempString2 = ""
End If
position = 0
position = InStr(1, TempString, "DEVICE_FIRMWARE=")
If position > 0 Then 'It is a device firmware command from a client
TempString2 = Mid(TempString, InStr(TempString, "=") + 1)
DeviceFirmwareLabel.Caption = "Firmware version: " & TempString2
Unload Form2 'Since this is the last piece we will be receiving we can close this window
TempString2 = ""
End If
position = 0
position = InStr(1, TempString, "DEVICE_OK=")
If position > 0 Then 'It is a device respond command from a client
TempString2 = Mid(TempString, InStr(TempString, "=") + 1)
TempList.AddItem (TempString2 + " - " + Socket2.RemoteHostIP)
Label1.Caption = "Connected clients: " & List1.ListCount
TempString2 = ""
End If
position = 0
position = InStr(1, TempString, "DEVICE_REBOOTING")
If position > 0 Then 'It is a device respond command from a client
Socket2.Close
TempString2 = ""
End If
Text1.Text = Text1.Text & TempString & vbNewLine
TempString = ""
position = 0
TempString2 = ""
End Sub
Private Sub Socket1_ConnectionRequest(ByVal requestID As Long)
If Socket1.State <> sckClosed Then
Socket1.Close
' Accept the request with the requestID
' parameter.
Socket1.Accept requestID
End If
End Sub
Private Sub Socket2_ConnectionRequest(ByVal requestID As Long)
If Socket2.State <> sckClosed Then
Socket2.Close
Socket2.Accept requestID 'Allow the connection
End If
End Sub
`
There's a lot there to dig through (You probably want to try to create a MCVE of the problem just to make your own debugging easier), but at first glance those ConnectionRequest event handlers seem suspect to me. The Winsock Control ConnectionRequest Event documentation says to "Use the Accept method (on a new control instance) to accept an incoming connection." You're trying to somehow use the same control instance, which maybe there's a way to do but isn't the standard approach.
If memory serves (it's been forever since I've dealt with this), you want to create a Control Array of Winsock Controls, and load a new instance at run time to handle each new connection (and unload it when the connection is complete). The "listening" control and the "handling a current connection" control need to be different instances. That way, each instance handles its own connection with its own state, and the listener is available to handle any new incoming connections.
Okay so i was able to find a very good example code for a multi-client server
And also i was able to figure out that the time out delay i created was WAY too short so that was why it was disappearing from the list. Sometimes it takes 10 seconds to receive a response and the time out was set to only 5 seconds MAX.
But still thanks for trying to help me :)
The link to the example code :LINK
I am trying to communicate with the syringe pump from PC through rs232.
I want to send a string "02DC;50803" to the pump for establishing the communication and pump should reply "C".
I am using MSComm1.Output="02DC;50803" to send the command and Text1.Text=Text1.Text+MSComm1.Input for receiving. When MSComm1.Output executes I am able to see a LED blinking on the end device but there is no reply using MSComm1.input.
Please help me out with this problem and if I put these instruction under MSComm() control, it seems to be dead.
There could be a number of problems here.
For example:
your cable could be broken
your serial port may not be functioning - I see that a lot
Your command is malformed
the pump simply doesn't expect to reply to the command you are sending
Those last 2 might be unlikely, the pump will probably reply to everything you fire at it - all the ones I have here sure answer back.
Really need a lot more information to help you.
What make/model pump?
Manual for the pump so that your commands can be checked.
Have you connected to the pump with an existing software package? - if there is one.
P.S. My software won't support your pump; I don't recognize those commands.
To continue the list from timb:
Are you using the correct baudrate?
What are the settings of .RThreshold and .SThreshold?
Are the other comport settings correct (usually N,8,1 but there are exceptions)?
Did you try the command using hyperterminal and get the expected reply?
Where in your code do you read MSComm1.Input? in Which event?
Does the device have a led as well which blinks it is when sending data? does it blink?
Does the command need an end-char like vbCrLf or vbCr of anything else?
Please post the complete code of the function/sub where you send the command, and please post the complete code of the function/sub where you read MSCOmm1.Input
Have a look at the following testproject in which I send the "AT" command to my modem which is connected to commport 1 and with which I communicate at baudrate 9600:
'1 form with:
' 1 textbox control : name=Text1
' 1 command button : name=Command1
' 1 MSComm control : name=MSComm1
Option Explicit
Private Sub Command1_Click()
MSComm1.Output = "at" & vbCrLf
End Sub
Private Sub Form_Load()
With MSComm1
If .PortOpen Then .PortOpen = False
.Settings = "9600,n,8,1"
.CommPort = 1
.RThreshold = 1 'read data per char
.SThreshold = 0 'send all data at once
.PortOpen = True
End With 'MSComm1
End Sub
Private Sub Form_Resize()
Dim sngWidth As Single
Dim sngCmdHeight As Single
Dim sngTxtHeight As Single
sngWidth = ScaleWidth
sngCmdHeight = 315
sngTxtHeight = ScaleHeight - sngCmdHeight
Text1.Move 0, 0, sngWidth, sngTxtHeight
Command1.Move 0, sngTxtHeight, sngWidth, sngCmdHeight
End Sub
Private Sub MSComm1_OnComm()
Dim strData As String
With MSComm1
Select Case .CommEvent
Case comEvReceive
strData = .Input
ShowData strData
End Select
End With 'MSComm1
End Sub
Private Sub ShowData(strData As String)
With Text1
.SelStart = Len(.Text)
.SelText = strData
End With 'Text1
End Sub
When I click on Command1 it will send "AT" & vbCrLf and the modem replies with "OK" which is shown in Text1.
Ive been looking for a solution to this for a while now and need a bit of help.
I need to detect when someone sends me a message to my outlook account when it does not have attachents.
I have a situation that.
An email is sent to me
There is spacific text in the subject
It has an attachment
If it has an attachment it sends reply 1 and moves the message to folder A
If it does not have an attachmnet it sends reply 2.and moves the message into folder B
Any help would be welcome
Many thanks
You can do this very easily in VBScript, like so:
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim m As Variant
Dim strBody As String
Dim intIn As Long
Dim intAttachCount As Integer, intStandardAttachCount As Integer
On Error GoTo handleError
'Edit the following line if you have a signature on your email that includes images or other files. Make intStandardAttachCount equal the number of files in your signature.
intStandardAttachCount = 0
strBody = LCase(Item.Body)
intIn = InStr(1, strBody, "original message")
If intIn = 0 Then intIn = Len(strBody)
intIn = InStr(1, Left(strBody, intIn), "attach")
intAttachCount = Item.Attachments.Count
If intIn > 0 And intAttachCount <= intStandardAttachCount Then
m = MsgBox("It appears that you mean to send an attachment," & vbCrLf & "but there is no attachment to this message." & vbCrLf & vbCrLf & "Do you still want to send?", vbQuestion + vbYesNo + vbMsgBoxSetForeground)
If m = vbNo Then Cancel = True
End If
handleError:
If Err.Number <> 0 Then
MsgBox "Outlook Attachment Reminder Error: " & Err.Description, vbExclamation, "Outlook Attachment Reminder Error"
End If
End Sub
This can be modified for your exact need, but it's pretty straightforward.
Simple Google search away. Give credit to the guy who wrote it.