VBA將數據從未打開的CSV文件複製到工作表而不打開已關閉CSV

Question

我相信我有一個獨特的問題，因爲我在互聯網上的任何地方都沒有看到任何類似的問題。

我是一名業務分析員/應用程序開發人員，我想自動從其他用戶的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文件，或該文件未打開。如果有辦法可以完成，請告訴我。目前，我收到了一個超出範圍的錯誤。

Answer 1

假設您只想獲取數據並將其放入當前工作簿中。我錄使用數據宏 - >導入數據的方法和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 

然後instea的d：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變量來匹配你在問題中描述的位置。

希望這是你正在尋找，如果不讓我知道。