[求助]关于VBA

SWAYWOOD

各位前辈，我没学过VBA，但听说VBA能实现我这种功能，


请帮个忙


我想在打开CAD的时候，就装载该程序，


这个程序的功能是：在上午10点时，检测服务器上的一台电脑


也就是说，这个程序在开启之后，就一直在后台运行，直到10点，发生检测电脑的事件！

efan2000

加载可以在acad.dvb中，或者在acaddoc.lsp编写代码来实现。定时执行，可以使用定时器，也可以通过循环来操作。如：

2. Sub Test()
3.        If Hour(Now) > 10 Then Exit Sub
4.        Do While Hour(Now) < 10
5.                DoEvents '空执行
6.        Loop
7.        Ping "192.168.0.1"
8. End Sub

Sub Test()        If Hour(Now) > 10 Then Exit Sub        Do While Hour(Now) < 10                DoEvents '空执行        Loop        Ping "192.168.0.1" End Sub

检测网络中的某一台电脑，实际上是Ping的操作，如果Ping的通，说明是连通的。

2. Const SOCKET_ERROR = 0
3. Private Type WSAdata
4.        wVersion As Integer
5.        wHighVersion As Integer
6.        szDescription(0 To 255) As Byte
7.        szSystemStatus(0 To 128) As Byte
8.        iMaxSockets As Integer
9.        iMaxUdpDg As Integer
10.        lpVendorInfo As Long
11. End Type
12. Private Type Hostent
13.        h_name As Long
14.        h_aliases As Long
15.        h_addrtype As Integer
16.        h_length As Integer
17.        h_addr_list As Long
18. End Type
19. Private Type IP_OPTION_INFORMATION
20.        TTL As Byte
21.        Tos As Byte
22.        Flags As Byte
23.        OptionsSize As Long
24.        OptionsData As String * 128
25. End Type
26. Private Type IP_ECHO_REPLY
27.        Address(0 To 3) As Byte
28.        Status As Long
29.        RoundTripTime As Long
30.        DataSize As Integer
31.        Reserved As Integer
32.        data As Long
33.        Options As IP_OPTION_INFORMATION
34. End Type
35. Private Declare Function GetHostByName Lib "wsock32.dll" Alias "gethostbyname" (ByVal HostName As String) As Long
36. Private Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequired&, lpWSAdata As WSAdata) As Long
37. Private Declare Function WSACleanup Lib "wsock32.dll" () As Long
38. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
39. Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long
40. Private Declare Function IcmpCloseHandle Lib "icmp.dll" (ByVal HANDLE As Long) As Boolean
41. Private Declare Function IcmpSendEcho Lib "ICMP" (ByVal IcmpHandle As Long, ByVal DestAddress As Long, ByVal RequestData As String, ByVal RequestSize As Integer, RequestOptns As IP_OPTION_INFORMATION, ReplyBuffer As IP_ECHO_REPLY, ByVal ReplySize As Long, ByVal TimeOut As Long) As Boolean
42. Private Sub Form_Load()
43.        'KPD-Team 2000
44.        'URL: http://www.allapi.net/
45.        'E-Mail: KPDTeam@Allapi.net
46.        Const HostName = "www.allapi.net"
47.        Dim hFile As Long, lpWSAdata As WSAdata
48.        Dim hHostent As Hostent, AddrList As Long
49.        Dim Address As Long, rIP As String
50.        Dim OptInfo As IP_OPTION_INFORMATION
51.        Dim EchoReply As IP_ECHO_REPLY
52.        Call WSAStartup(&H101, lpWSAdata)
53.        If GetHostByName(HostName + String(64 - Len(HostName), 0)) <> SOCKET_ERROR Then
54.                CopyMemory hHostent.h_name, ByVal GetHostByName(HostName + String(64 - Len(HostName), 0)), Len(hHostent)
55.                CopyMemory AddrList, ByVal hHostent.h_addr_list, 4
56.                CopyMemory Address, ByVal AddrList, 4
57.        End If
58.        hFile = IcmpCreateFile()
59.        If hFile = 0 Then
60.                MsgBox "Unable to Create File Handle"
61.                Exit Sub
62.        End If
63.        OptInfo.TTL = 255
64.        If IcmpSendEcho(hFile, Address, String(32, "A"), 32, OptInfo, EchoReply, Len(EchoReply) + 8, 2000) Then
65.                rIP = CStr(EchoReply.Address(0)) + "." + CStr(EchoReply.Address(1)) + "." + CStr(EchoReply.Address(2)) + "." + CStr(EchoReply.Address(3))
66.        Else
67.                MsgBox "Timeout"
68.        End If
69.        If EchoReply.Status = 0 Then
70.                MsgBox "Reply from " + HostName + " (" + rIP + ") recieved after " + Trim$(CStr(EchoReply.RoundTripTime)) + "ms"
71.        Else
72.                MsgBox "Failure ..."
73.        End If
74.        Call IcmpCloseHandle(hFile)
75.        Call WSACleanup
76. End Sub

Const SOCKET_ERROR = 0 Private Type WSAdata        wVersion As Integer        wHighVersion As Integer        szDescription(0 To 255) As Byte        szSystemStatus(0 To 128) As Byte        iMaxSockets As Integer        iMaxUdpDg As Integer        lpVendorInfo As Long End Type Private Type Hostent        h_name As Long        h_aliases As Long        h_addrtype As Integer        h_length As Integer        h_addr_list As Long End Type Private Type IP_OPTION_INFORMATION        TTL As Byte        Tos As Byte        Flags As Byte        OptionsSize As Long        OptionsData As String * 128 End Type Private Type IP_ECHO_REPLY        Address(0 To 3) As Byte        Status As Long        RoundTripTime As Long        DataSize As Integer        Reserved As Integer        data As Long        Options As IP_OPTION_INFORMATION End Type Private Declare Function GetHostByName Lib "wsock32.dll" Alias "gethostbyname" (ByVal HostName As String) As Long Private Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequired&, lpWSAdata As WSAdata) As Long Private Declare Function WSACleanup Lib "wsock32.dll" () As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long) Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long Private Declare Function IcmpCloseHandle Lib "icmp.dll" (ByVal HANDLE As Long) As Boolean Private Declare Function IcmpSendEcho Lib "ICMP" (ByVal IcmpHandle As Long, ByVal DestAddress As Long, ByVal RequestData As String, ByVal RequestSize As Integer, RequestOptns As IP_OPTION_INFORMATION, ReplyBuffer As IP_ECHO_REPLY, ByVal ReplySize As Long, ByVal TimeOut As Long) As Boolean Private Sub Form_Load()        'KPD-Team 2000        'URL: http://www.allapi.net/        'E-Mail: KPDTeam@Allapi.net        Const HostName = "www.allapi.net"        Dim hFile As Long, lpWSAdata As WSAdata        Dim hHostent As Hostent, AddrList As Long        Dim Address As Long, rIP As String        Dim OptInfo As IP_OPTION_INFORMATION        Dim EchoReply As IP_ECHO_REPLY        Call WSAStartup(&H101, lpWSAdata)        If GetHostByName(HostName + String(64 - Len(HostName), 0)) <> SOCKET_ERROR Then                CopyMemory hHostent.h_name, ByVal GetHostByName(HostName + String(64 - Len(HostName), 0)), Len(hHostent)                CopyMemory AddrList, ByVal hHostent.h_addr_list, 4                CopyMemory Address, ByVal AddrList, 4        End If        hFile = IcmpCreateFile()        If hFile = 0 Then                MsgBox "Unable to Create File Handle"                Exit Sub        End If        OptInfo.TTL = 255        If IcmpSendEcho(hFile, Address, String(32, "A"), 32, OptInfo, EchoReply, Len(EchoReply) + 8, 2000) Then                rIP = CStr(EchoReply.Address(0)) + "." + CStr(EchoReply.Address(1)) + "." + CStr(EchoReply.Address(2)) + "." + CStr(EchoReply.Address(3))        Else                MsgBox "Timeout"        End If        If EchoReply.Status = 0 Then                MsgBox "Reply from " + HostName + " (" + rIP + ") recieved after " + Trim$(CStr(EchoReply.RoundTripTime)) + "ms"        Else                MsgBox "Failure ..."        End If        Call IcmpCloseHandle(hFile)        Call WSACleanup End Sub

这是一个Ping操作的例子，可以参考一下。

SWAYWOOD

多谢了，如果是找一个文件夹是否会简单一些呢？


有关定时器的使用的简单程序有吗？

雪山飞狐_lzh

用Shell调用Dos命令Ping并将结果输出到文件，再根据文件内容判断是否Ping通

SWAYWOOD

楼上的能说清楚点么？

yuangw1234

你们的VBA学得真让我偑服，面面俱到