1

我相信我有一个独特的问题，因为我在互联网上的任何地方都没有看到类似的东西。

我是一名业务分析师/应用程序开发人员，我想从其他用户的个人计算机上的 Excel CSV 文件中自动收集数据，而无需打开文件并破坏它们。有办法吗？

这是我到目前为止的代码：

Option Explicit

Dim MyDocuments As String, strFileName, myToday, origWorkbook, origWorksheet, strConnection
Dim row As Integer

Private Sub btnStart_Click()
    MyDocuments = Environ$("USERPROFILE") & "\My Documents"
    myToday = Format(Date, "mmddyy")
    strFileName = "DataFile" & myToday & ".csv"
    strConnection = "TEXT;" & MyDocuments & "\DataFolder\" & strFileName
    origWorksheet = "DataFile" & myToday

    row = 1
    On Error Resume Next
    row = Range("A1").End(xlDown).row + 1

    With ActiveSheet.QueryTables.Add(Connection:=strConnection, Destination:=Range("$A$" & row))
        .Name = "temp"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .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 Sub

就像我说的，我不希望 CSV 文件在他们工作时打开。我希望在幕后这样做，这样他们就可以在我们收集数据的同时继续工作。

我猜我最大的问题是它是一个 CSV 文件，或者该文件未打开。如果有办法可以做到这一点，请告诉我。目前，我遇到了超出范围的错误。

4

1 回答 1

4

假设您只想获取数据并将其放入当前工作簿中。我使用 Data -> Import Data 方法和 VBA 录制了一个宏，它似乎可以与关闭的 CSV 文件一起使用：

打印到连续列：

Sub Macro1()

    Dim MyDocuments, strFileName, myToday, file, strConnection As String

    MyDocuments = Environ$("USERPROFILE") & "\My Documents"
    myToday = Format(Date, "mmddyy")
    strFileName = "DataFile" & myToday & ".csv"

    strConnection = "TEXT;" & MyDocuments & "\DataFolder\" & strFileName
    With ActiveSheet.QueryTables.Add(Connection:= _
         strConnection, Destination:=Range("$A$1"))
        .Name = "temp"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .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 Sub

打印到连续行：

在这里我们必须添加

Dim row As Integer
    row = 1
    On Error Resume Next

    row = Range("A1").End(xlToRight).End(xlDown).row + 1

然后代替：Destination:=Range("$A$1") 我们使用行变量：Destination:=Range($A$" & row)

Sub Macro1()

    Dim MyDocuments, strFileName, myToday, file, strConnection As String

    MyDocuments = Environ$("USERPROFILE") & "\My Documents"
    myToday = Format(Date, "mmddyy")
    strFileName = "DataFile" & myToday & ".csv"

    Dim row As Integer
    row = 1
    On Error Resume Next
    row = Range("A1").End(xlDown).row + 1

    strConnection = "TEXT;" & MyDocuments & "\DataFolder\" & strFileName
    With ActiveSheet.QueryTables.Add(Connection:= _
         strConnection, Destination:=Range("$A$" & row))
        .Name = "temp"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .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 Sub

这将获取所有 CSV 数据并将其放入A1您可以将其更改为$A$1您想要的任何位置。当然，您也可以更改所有其他变量，我只是记录了宏并编辑了strConnection变量以匹配您在问题中描述的位置。

希望这是您正在寻找的，如果没有让我知道。

于 2013-07-11T20:16:18.820 回答