|
楼主 |
发表于 2023-2-13 12:33
|
显示全部楼层
感谢指点,有几个地方能还改下吗?
1. 提取的内容可以固定在1个工作薄上吗?不用每次新建工作簿;
2. 想加个循环语句进去,请见下文不知道怎么改;
3. 每循环1次停顿3秒
Sub chxun()
For i = 1 To 40 循环代码
Dim n&, nm$, c As Range
For Each c In Sheets("链接").Range("a1").CurrentRegion
n = Format(Now, "ddhhmmss")
nm = "Table 0 (" & n & ")"
ActiveWorkbook.Queries.Add Name:=nm, Formula:= _
"let" & Chr(13) & "" & Chr(10) & " 源 = Web.Page(Web.Contents(""" & c.Value & """))," & Chr(13) & "" & Chr(10) & " Data0 = 源{0}[Data]" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " Data0"
ActiveWorkbook.Worksheets.Add
ActiveSheet.Name = n
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""" & nm & """;Extended Properties=""""" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Table 0 (" & n & ")]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Table_0__" & n
.Refresh BackgroundQuery:=False
End With
Next
Application.Wait (Now + TimeValue("00:00:03")) 停顿代码
Next i 循环代码
End Sub |
|