纯 VBA 非 Seliumn 同时控制谷歌Chrome和微软Edge浏览器

HHAAMM

我的edge浏览器不知道怎么设置的，关闭之后还有进程，加了结束进程树的代码，每次运行前先运行这个。

1. Option Explicit
   
2. 
   
3. #If VBA7 Then
   
4.     Declare PtrSafe Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As LongPtr
   
5.     Declare PtrSafe Function Process32First Lib "kernel32" (ByVal hSnapshot As LongPtr, uProcess As PROCESSENTRY32) As Long
   
6.     Declare PtrSafe Function Process32Next Lib "kernel32" (ByVal hSnapshot As LongPtr, uProcess As PROCESSENTRY32) As Long
   
7.     Declare PtrSafe Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As LongPtr
   
8.     Declare PtrSafe Function TerminateProcess Lib "kernel32" (ByVal hProcess As LongPtr, ByVal uExitCode As Long) As Long
   
9. #Else
   
10.     Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
    
11.     Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
    
12.     Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
    
13.     Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
    
14.     Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
    
15. #End If
    
16. 
    
17. Private Const TH32CS_SNAPPROCESS As Long = 2
    
18. Private Const PROCESS_TERMINATE As Long = &H1
    
19. Private Const MAX_PATH As Integer = 260
    
20. 
    
21. Private Type PROCESSENTRY32
    
22.     dwSize As Long
    
23.     cntUsage As Long
    
24.     th32ProcessID As Long
    
25.     th32DefaultHeapID As Long
    
26.     th32ModuleID As Long
    
27.     cntThreads As Long
    
28.     th32ParentProcessID As Long
    
29.     pcPriClassBase As Long
    
30.     dwFlags As Long
    
31.     szExeFile As String * MAX_PATH
    
32. End Type
    
33. 
    
34. Sub TerminateEdgeProcesses()
    
35.     Dim hSnapshot As LongPtr
    
36.     Dim uProcess As PROCESSENTRY32
    
37.     Dim hProcess As LongPtr
    
38.     Dim strProcessName As String
    
39.    
    
40.     ' 初始化结构体
    
41.     uProcess.dwSize = Len(uProcess)
    
42.    
    
43.     ' 创建进程快照
    
44.     hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
    
45.     If hSnapshot <> 0 Then
    
46.         ' 查找第一个进程
    
47.         If Process32First(hSnapshot, uProcess) Then
    
48.             Do
    
49.                 ' 获取进程名
    
50.                 strProcessName = Left(uProcess.szExeFile, InStr(1, uProcess.szExeFile, Chr(0)) - 1)
    
51.                
    
52.                 ' 如果是Edge进程，则尝试结束
    
53.                 If InStr(1, strProcessName, "msedge.exe", vbTextCompare) > 0 Then
    
54.                     ' 打开进程
    
55.                     hProcess = OpenProcess(PROCESS_TERMINATE, 0, uProcess.th32ProcessID)
    
56.                     If hProcess <> 0 Then
    
57.                         ' 结束进程
    
58.                         TerminateProcess hProcess, 0
    
59.                         CloseHandle hProcess
    
60.                     End If
    
61.                 End If
    
62.                
    
63.             Loop While Process32Next(hSnapshot, uProcess)
    
64.         End If
    
65.         ' 关闭快照句柄
    
66.         CloseHandle hSnapshot
    
67.     End If
    
68. End Sub

复制代码

半夏知秋

赞一个，外加收藏

cliffordzk

我想看看能不能用这个下载文件

cliffordzk

大神能不能帮忙改一下，就是要从这相地方进去
https://www.safe.gov.cn/safe/gzhbdmyzslb/index.html
下载最新一个月的各种货币对美元折算率
还有从https://www.safe.gov.cn/safe/rmbhlzjj/index.html
点击导出表格存到电脑指定盘
谢谢。

cliffordzk

有没有大神可以帮忙：
要从这儿点导出表格，存到电脑指定位置
https://www.safe.gov.cn/safe/rmbhlzjj/index.html
再从这儿https://www.safe.gov.cn/safe/gzhbdmyzslb/index.html
下载最新一份各种货币对美元折算率表也是存到指定位置。
谢谢

伶俐的毛豆

hck21cn

非常感谢大神分享！这对于只能在内网使用，不能上外网的环境非常适用，Excel版本比较低的需要把所有的PtrSaft 删掉，把所有LongPtr替换成Long才能使用，否则报错。

满天星辰不及你

32位的EXCEL 好像不支持， 虚拟机中运行64位可以

freeuping

尝试导入到access里面执行的时候错误太多。。。。
楼主能否提供个accessvba类，这个加上数据库就相当强大了，
另外这个打开浏览器必修独占么 有没有好办法去掉这个限制。

tcdatongye

打开谷歌是图片处出错，edge是Call objBrowser.attach("")出错。