将特定的CSV添加到VBA中的工作簿

时间:2019-01-22 09:21:36

标签: excel vba

我有一个Excel工作簿,我想将特定的CSV添加为新工作表,然后将其转换为表格。

这是我的VBA代码,可以正常工作,问题是当我想将工作表转换为选项卡时,Excel会给我这个错误:

  

表不能与包含数据透视表报表,查询结果,受保护的单元格或其他表的范围重叠。

Sub Macro8()
     '
     '
    Dim strPath As String
    Dim strFile As String
     '
    strPath = "Q:\myfolder\"
    strFile = Dir(strPath & "filename" & Format(Now(), "YYYYMMDD") & ".csv")
    Do While strFile <> ""
        With ActiveWorkbook.Worksheets.Add
            With .QueryTables.Add(Connection:="TEXT;" & strPath & strFile, _
                Destination:=.Range("A1"))
                .Parent.Name = Replace(strFile, ".csv", "")
                .TextFileParseType = xlDelimited
                .TextFileTextQualifier = xlTextQualifierDoubleQuote
                .TextFileConsecutiveDelimiter = False
                .TextFileTabDelimiter = False
                .TextFileSemicolonDelimiter = False
                .TextFileCommaDelimiter = True
                .TextFileSpaceDelimiter = False
                .TextFileColumnDataTypes = Array(1)
                .TextFileTrailingMinusNumbers = True
                .Refresh BackgroundQuery:=False
            End With
        End With
        strFile = Dir
     Loop

End Sub


Sub A_SelectAllMakeTable()
    Dim tbl As ListObject
    Dim rng As Range

    Set rng = Range(Range("A1"), Range("A1").SpecialCells(xlLastCell))
    Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, rng, , xlYes)
    tbl.Name = "OPEN"
    tbl.TableStyle = "TableStyleMedium15"
End Sub

有人可以帮我吗?

1 个答案:

答案 0 :(得分:1)

  

表不能与包含数据透视表报表,查询结果,受保护的单元格或其他表的范围重叠。

您需要先断开查询表的连接,否则您将收到所得到的错误。这是您要尝试的吗?

Sub A_SelectAllMakeTable()
    Dim tbl As ListObject
    Dim rng As Range
    Dim ws As Worksheet
    Dim lCol As Long, lRow As Long

    Set ws = ActiveSheet

    With ws
        '~~> Delete the connection
        For Each Cn In .QueryTables
            Cn.Delete
        Next Cn

        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            '~~> Find last row and column to construct your range
            lRow = .Cells.Find(What:="*", _
                    After:=.Range("A1"), _
                    Lookat:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Row

            lCol = .Cells.Find(What:="*", _
                    After:=.Range("A1"), _
                    Lookat:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByColumns, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Column

            Set rng = .Range(.Cells(1, 1), .Cells(lRow, lCol))

            Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, rng, , xlYes)
            tbl.Name = "OPEN"
            tbl.TableStyle = "TableStyleMedium15"
        End If
    End With
End Sub