自动获取网站并实时更新

muziyulin

源文件中自动获取http://61.145.246.228:8081/zhjdxt/mainpage/home/gettp.aspx的日期，获取的信息是

现在网址改了，https://zjj.zhuhai.gov.cn/zjj/zwgk/zzjg/jsdw/zhsjsgczljdjcz/，我查看源码的时候发现是https://www.zhjdxt.cn/viewWarning，替换网址会发生错误。麻烦帮忙处理一下。

源VBA：

1. Option Explicit
   
2. Sub IE()
   
3.     Dim IE As Object, url As String, arr, i As Integer, str As String
   
4.     Application.ScreenUpdating = False
   
5.     Set IE = CreateObject("InternetExplorer.Application")
   
6.     url = "http://61.145.246.228:8081/zhjdxt/mainpage/home/gettp.aspx"
   
7.     With IE
   
8.         .Visible = False '不可见
   
9.         .navigate url '访问
   
10.         IEWait IE '等待
    
11.         arr = Split(.document.body.innertext, Chr(10)) '页面结果放入数组
    
12.         Range("A1").Resize(UBound(arr) + 1, 1) = WorksheetFunction.Transpose(arr) '写入单元格
    
13.         Range("1:8,10:10,12:15,17:17").Delete '删除无效行
    
14.         For i = 1 To Range("A1").CurrentRegion.Rows.Count
    
15.             str = Range("A" & i)
    
16.             If InStr(str, "、") = 0 Then
    
17.                 Range("A" & i) = Format(Replace(Left(str, InStr(str, "日") - 1), "月", "-"), "yyyy年m月d日")
    
18.                 Range("B" & i) = Format(Mid(str, InStr(str, "：") + 1), "yyyy年m月d日")
    
19.             Else
    
20.                 Range("A" & i) = Format(Replace(Left(str, InStr(str, "日") - 1), "月", "-"), "yyyy年m月d日")
    
21.                 Range("B" & i) = Format(Mid(Mid(str, InStr(str, "：") + 1), 1, InStr(Mid(str, InStr(str, "：") + 1), "、") - 1), "yyyy年m月d日")
    
22.                 Range("C" & i) = Format(Mid(str, InStr(str, "、") + 1), "yyyy年m月d日")
    
23.             End If
    
24.         Next
    
25.         .Quit
    
26.     End With: Set IE = Nothing
    
27.     Application.ScreenUpdating = True
    
28.     Range("A1").CurrentRegion.Select: MsgBox "日期已更新", vbInformation, "VBA"
    
29. End Sub
    
30. Function IEWait(ByRef objIE As Object)
    
31.     Do While objIE.Busy = True Or objIE.readyState <> 4
    
32.         DoEvents
    
33.     Loop
    
34. End Function

复制代码

养护日期_v1.2.xlsm.zip (15.8 KB, 下载次数: 2)

2024-3-20 10:23 上传

点击文件名下载附件

muziyulin

zpy2

muziyulin 发表于 2024-3-22 08:41

可以考虑油猴子脚本，这个貌似加密而且用了框架，用协议需要抓包

muziyulin

muziyulin

付费求助 付费求助 付费求助

perfect131

muziyulin 发表于 2024-3-23 15:34
付费求助 付费求助 付费求助

好，找我