使用Excel免费批量发送手机短信

xrs08234

这是俺找了很久的东东，很有创意。不过怎么测试没有成功呢？
源代码如下：

Function SendMsg(Wpath, Mobile, Sword, ProxyIP, ProxyPort, Sendto, Msg)
If Trim(ProxyPort) <> "" And Trim(ProxyIP) <> "" Then
SendMsg = Shell(Wpath & "\msg\fetion.exe --mobile=" & Mobile & " --pwd=" & Sword & "--proxy-ip=" & ProxyIP & "--proxy-port=" & ProxyPort & " --msg-type=1 --to=" & Sendto & " --msg-gb=" & Msg, 0)
Else
SendMsg = Shell(Wpath & "\msg\fetion.exe --mobile=" & Mobile & " --pwd=" & Sword & " --msg-type=1 --to=" & Sendto & " --msg-gb=" & Msg, 0)
End If
End Function
Sub Send()
Dim Wpath, Mobile, Sword, ProxyIP, ProxyPort, Sendto, Msg, Temp
Wpath = ThisWorkbook.Path
Mobile = ThisWorkbook.Sheets("飞信账户设置").Cells(3, 3).Value
Sword = ThisWorkbook.Sheets("飞信账户设置").Cells(4, 3).Value
ProxyIP = ThisWorkbook.Sheets("飞信账户设置").Cells(6, 3).Value
ProxyPort = ThisWorkbook.Sheets("飞信账户设置").Cells(7, 3).Value
Maxrows = Application.WorksheetFunction.Max(Range("A" & Rows.Count).End(xlUp).Row, Range("B" & Rows.Count).End(xlUp).Row, Range("C" & Rows.Count).End(xlUp).Row, Range("D" & Rows.Count).End(xlUp).Row, Range("E" & Rows.Count).End(xlUp).Row)
Sheets("发送短信").Range("E3:E" & Maxrows).ClearContents
For I = 3 To Maxrows
If Trim(ThisWorkbook.Sheets("发送短信").Cells(I, 1).Value) <> "是" Then
Sheets("发送短信").Cells(I, 5).Value = "本次发送剔除此条短信"
GoTo Net
End If
If Trim(ThisWorkbook.Sheets("发送短信").Cells(I, 3).Value) = "" Then
Sheets("发送短信").Cells(I, 5).Value = "短信接收号码不能为空白"
GoTo Net
End If
If Trim(ThisWorkbook.Sheets("发送短信").Cells(I, 4).Value) = "" Then
Sheets("发送短信").Cells(I, 5).Value = "短信内容不能为空白"
GoTo Net
End If
Sendto = ThisWorkbook.Sheets("发送短信").Cells(I, 3).Value
Msg = ThisWorkbook.Sheets("发送短信").Cells(I, 4).Value
Temp = SendMsg(Wpath, Mobile, Sword, ProxyIP, ProxyPort, Sendto, Msg)
Sheets("发送短信").Cells(I, 5).Value = "已经将消息发送到服务器"
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + ThisWorkbook.Sheets("飞信账户设置").Cells(11, 3).Value
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
Net:
Next I
MsgBox "短信已经全部发送完毕", , "温馨提示"
End Sub

zuiaidh2004

正在研究使用中

xrs08234

已经成功，感谢楼主的无私奉献！！

a296837698

看看。。。。。。。。

纷纷

看看·~~~~~~~~~~~~~~~~~~~~~~··

gwfzh

支持一下，谢谢分享。

东亚五金

不会用手机发短信的飘过

gendvd

好贴，一直有这个需求，希望楼主把后期的研究也发出来共享。谢谢。！！！！！！！！！！！！！！！

wuxiang1656

{:soso_e183:}

geryjun

好帖，值得学习……