将HTML的内容复制到列错误处理VBA Excel

时间:2015-04-09 19:10:14

标签: excel vba

解决!!!我遵循jbarker2160的建议On Error Resume Next是解决方案。 我还改进了我的代码,使其使用更少的资源。

Sub Project()
Dim locationArr As Variant
Dim i As Long
Dim g_strVar As String
Dim fake As String

 locationArr = Range("C1:C8877").Value

For i = LBound(locationArr) To UBound(locationArr)
    fake = (locationArr(i, 1))
     g_strVar = ImportTextFile(fake)
     ActiveCell.Value = g_strVar
ActiveCell.Offset(1, 0).Select

    g_strVar = ""



Next i
End Sub

Function ImportTextFile(strFile As String) As String

On Error Resume Next
    Open strFile For Input As #1
    ImportTextFile = Input$(LOF(1), 1)
    Close #1

End Function

原始问题 如何在此过程中创建错误处理? 第一次使用。

我将本地备份文件内容从Intranet复制到csv。我一直在为VBA建立解决方案而磕磕绊绊。现在我需要弄清楚如何处理错误。

我当前的工作表包含产品SKU列表,产品名称以及填充页面的html文件的文件路径(其中一些是过时的路径)。

使用VBA我已将文件路径放入单维数组中。 我创建了一个循环来遍历数组打开文件路径,复制文件的内容,关闭文件,并将文件的内容放入单元格。

如何处理损坏/丢失的文件路径?

Sub Project()
Dim locationArr As Variant
Dim Shex As Object
Dim i As Long
  Dim DataObj As New MSForms.DataObject
  Dim S As String
   '
   'access clipboard
  DataObj.GetFromClipboard
  S = DataObj.GetText
  '
  '
  ' create array
 locationArr = Range("C1:C8877").Value
 '
 '
 ' access file
 Set Shex = CreateObject("Shell.Application")
 '
 '
 '
 'loop array
For i = LBound(locationArr) To UBound(locationArr)
   '
   'open file
   Shex.Open (locationArr(i, 1))
   '
   ' give it time to open
   Application.Wait (Now + TimeValue("0:00:01"))
   ' handle file
   Application.SendKeys ("^a")
   Application.SendKeys ("^c")
   Application.SendKeys ("%{F4}")
   ' give it time to close
Application.Wait (Now + TimeValue("0:00:01"))
   '
   'place clipboard into active cell
ActiveCell.Value = S
   '
   'move to new active cell
ActiveCell.Offset(1, 0).Select
   '
   ' loop back
Next i
End Sub

1 个答案:

答案 0 :(得分:0)

您可以简单地将On Error Resume Next放在代码的顶部,但在某些情况下这可能会很危险。

我没有预见到任何问题,但是如果您稍后对代码进行任何调整或添加,则可能需要重新评估。

目前,您可以预期的最糟糕的是一些丢失的数据或一堆打开的文件。

如果路径永远不会再次有效,您可以使用错误处理程序从列表中删除该路径。