在Excel中导入网页数据而不覆盖历史logging

我从一个在线电话日志导入数据到excel。 它基本上是这样的:

Date Time Duration Local Identity Number 14.12.2016 11:11 00:03 88821354@192.168.1.2 22252797 14.12.2016 10:33 00:02 88821354@192.168.1.2 25322678 

我已经成功地将数据导入Excel。 然而,电话logging本身真的很烦人,因为它只保留最近的呼叫数据到任何给定的号码。 也就是说,如果我拨打上面列表中的第二个号码(25322678),我将丢失之前呼叫的数据(在10:33做出)。 这将在Excel中镜像。

我想知道是否有办法连续导入新的数据,而不会覆盖旧的。 在我看来,似乎没有办法通过调整导入设置,所以我正在考虑不同的解决方法。 尽pipe如此,我还没有能够提供任何远程的能力。

此解决scheme创build名为“PhoneLog”的工作表以保存“From web”function的累积结果。

此过程假定“From web”函数的结果位于范围A:E名为“WebFrom”的工作表中,从第1行开始(根据需要更改)

此过程必须位于保存“From web”function的结果的同一工作簿中。

更新“From web”function之前 ,首先运行此过程,以便将实际结果添加到“PhoneLog”中。 之后,在“从networking”function之后立即运行此程序。

如果在工作簿中找不到该过程,则会创build“PhoneLog”工作表。 然后将“WebFrom”工作表中的所有新logging添加到“PhoneLog”中 (根据需要更改)

 Option Explicit Sub Phone_Log() Const kWebFrom As String = "WebFrom" 'change as required Const kPhoneLog As String = "PhoneLog" 'change as required Dim wshWeb As Worksheet, wshLog As Worksheet Dim blwshNew As Boolean Dim rWeb As Range, rLog As Range Dim aWeb As Variant, vItm As Variant Dim lRow As Long, l As Long Rem Set Worksheets With ThisWorkbook Set wshWeb = .Worksheets(kWebFrom) On Error Resume Next Set wshLog = .Worksheets(kPhoneLog) On Error GoTo 0 If wshLog Is Nothing Then blwshNew = True Set wshLog = .Worksheets.Add(After:=wshWeb) wshLog.Name = kPhoneLog End If: End With Rem Set FromWeb Array With wshWeb If Not (.AutoFilter Is Nothing) Then .Cells(1).AutoFilter Set rWeb = .Cells(1).CurrentRegion End With With rWeb .AutoFilter Field:=1, Criteria1:="<>" Set rWeb = .Cells.SpecialCells(xlCellTypeVisible) aWeb = .Offset(1).Resize(-1 + .Rows.Count).SpecialCells(xlCellTypeVisible).Value2 .AutoFilter End With Rem Set Log Array With wshLog If blwshNew Then Rem Set Log - First Time rWeb.Copy .Cells(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats Application.CutCopyMode = False .Cells(1).CurrentRegion.Columns.AutoFit Else Rem Add New Records into Log Range Set rLog = .Cells(1).CurrentRegion With rLog lRow = .Rows.Count For l = 1 To UBound(aWeb) vItm = WorksheetFunction.Index(aWeb, l, 0) 'Use this line if running the "FromWeb" function for one IP address only 'If WorksheetFunction.CountIfs(.Columns(1), vItm(1), _ .Columns(2), vItm(2), .Columns(5), vItm(5)) = 0 Then 'Use this line if running the "FromWeb" function for several IP addresses If WorksheetFunction.CountIfs(.Columns(1), vItm(1), _ .Columns(2), vItm(2), .Columns(4), vItm(4), .Columns(5), vItm(5)) = 0 Then lRow = 1 + lRow .Rows(lRow).Value = vItm End If: Next: End With Rem Format Log Range Set rLog = .Cells(1).CurrentRegion With rLog .Rows(2).Copy .Offset(1).Resize(-1 + .Rows.Count).PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False .Columns.AutoFit End With Rem Sort Log Range With .Sort .SortFields.Clear .SortFields.Add Key:=rLog.Columns(1), SortOn:=xlSortOnValues, _ Order:=xlDescending, DataOption:=xlSortNormal .SortFields.Add Key:=rLog.Columns(2), SortOn:=xlSortOnValues, _ Order:=xlDescending, DataOption:=xlSortNormal 'Use also this line if running the "FromWeb" function for several IP addresses .SortFields.Add Key:=rLog.Columns(4), SortOn:=xlSortOnValues, _ Order:=xlAscending, DataOption:=xlSortNormal .SetRange rLog .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With: End If: End With End Sub 

build议阅读以下页面,以深入了解所使用的资源:

Excel对象 , 每个…下一个语句 , 如果…然后…其他语句 ,

在错误语句 , 选项显式语句 ,

范围对象(Excel) , Range.CurrentRegion属性(Excel) , Range.Offset属性(Excel) ,

Range.PasteSpecial方法(Excel) , Range.SpecialCells方法(Excel) ,

使用数组 , variables和常量 , 使用语句 , 工作簿对象(Excel) ,

Worksheet.AutoFilter属性(Excel) , Worksheet.Sort属性(Excel) ,

WorksheetFunction对象(Excel) 。

复制旧数据,刷新,复制新数据,删除重复

我可能会使用这种方法:

  1. 在每次新的刷新查询之前,我会将现有数据复制到“所有数据”表中。
  2. 刷新来自Web查询
  3. 将步骤2中的新数据复制到“所有数据”表中,并追加到底部。
  4. 删除重复项。

替代方法:HTTP请求或Internet Explorer导航

考虑使用HTTP请求获取响应文本而不是Excel导入数据function。 或者您可以使用Internet Explorer对象导航到该网站。

然后,您可以将响应文本分配给HTMLDocument并获取所需的数据。 或者你可以使用一些正则expression式来提取它。

然后,您可以导入所有数据,然后删除重复项,也可以在导入之前进行扫描,查看logging是否存在,然后只导入它。