VBA报错，自动化错误“-2147417846（8001010a）

shancyin2016 2016-11-29 11:25:09

如题，自己写了一段VBA代码，目的想通过FileDialog打开文件（csv格式），提取数据。
代码本身应该是没有问题的，我将同样的文件放到其他电脑上能运行。
但是用现在的电脑缺会出现以下的问题：

程序调试停在：

下面是整个代码，希望大家帮忙看看，如何解决。
PS，用的Excel版本是2010，之前用2013遇到过这问题，以为是版本原因，换了。重新安装好的时候下面的代码是能用的，但是过一段时间就会出现上面的报错。

Sub Import()



Dim Path As String

Dim ObjApplication As Application

Dim WB As Workbook

Dim Sht As Worksheet

Dim StrtgyID As String, Length As Integer



With Application.FileDialog(msoFileDialogFilePicker)

    .AllowMultiSelect = False

    .Filters.clear

    .Filters.Add "Excel Files", "*.csv"

    .Filters.Add "All Files", "*.*"

    If .Show <> -1 Then Exit Sub

    Path = .SelectedItems(1)

End With



Set ObjApplication = New Application

With ObjApplication

    .Visible = False

    .DisplayAlerts = False

End With



Set WB = ObjApplication.Workbooks.Open(Path, , True)

Set Sht = WB.Worksheets(1)



Dim HoldInfo As Variant



Dim Cnt As Integer, i As Integer



If Sht.Cells(1, 2) <> "代码" Then

    MsgBox ("导入的数据格式有误,请确认后重新导入!")

    Exit Sub

End If



Cnt = 0

For i = 1 To Sht.UsedRange.Rows.Count

    If IsNumeric(Sht.Cells(i, 2)) Then

        Cnt = Cnt + 1

    End If

Next i



If Cnt = 0 Then

    MsgBox "Imported Files Are Empty."

    Exit Sub

End If



Sheets("持仓").Range("A1" & ":" & "J" & CStr(Sheets("持仓").UsedRange.Rows.Count)).clear

Sheets("持仓").Range("L2").Value = Path



Dim j As Integer, Idx As Integer



Sheets("当前持仓").Cells(1, 1) = "名称"

Sheets("当前持仓").Cells(1, 2) = "账户"

Sheets("当前持仓").Cells(1, 3) = "代码"

Sheets("当前持仓").Cells(1, 4) = "简称"

Sheets("当前持仓").Cells(1, 5) = "持仓"

Sheets("当前持仓").Cells(1, 6) = "市值"

Sheets("当前持仓").Cells(1, 7) = "成本"

Sheets("当前持仓").Cells(1, 8) = "盈亏"



Length = UBound(Split(Path, "\"))

StrtgyID = CStr(Split(Split(Path, "\")(Length), ".")(0))



Idx = 2

For j = 2 To Sht.UsedRange.Rows.Count

    If Sht.Cells(j, 2) <> "" And Val(Split(Sht.Cells(j, 1), "(")(0)) = Val(Sheets("持仓").Range("P5").Value) Then

        Sheets("持仓").Cells(Idx, 1) = StrtgyID

        Sheets("持仓").Cells(Idx, 2) = Val(Split(Sht.Cells(j, 1), "(")(0))

        Sheets("持仓").Cells(Idx, 3) = Sht.Cells(j, 2)

        Sheets("持仓").Cells(Idx, 5) = Sht.Cells(j, 5)

        Sheets("持仓").Cells(Idx, 6) = Sht.Cells(j, 13)

        Sheets("持仓").Cells(Idx, 7) = Sht.Cells(j, 5) * Sht.Cells(j, 10)

        Sheets("持仓").Cells(Idx, 8) = Sht.Cells(j, 13) - Sht.Cells(j, 5) * Sht.Cells(j, 10)



        Idx = Idx + 1

    End If

Next j



Sheets("持仓").Range("C:C").NumberFormatLocal = "000000"

Sheets("持仓").Range("E:H").NumberFormatLocal = "#,##0.00"



WB.Close False

Set Sht = Nothing

Set WB = Nothing

Set ObjApplication = Nothing



End Sub