CODEWITHSUNDEEP
csvexcelvba
Lou
Lou

Reputation: 403

VBA Copy data from an unopened CSV file to worksheet without opening closed CSV

I believe I have a unique problem as I have not seen anything like it anywhere on the Internet.

I am a business analyst/application developer and I want to automatically gather the data from other user's Excel CSV file on their personal computer without opening the file and disrupting them. Is there a way?

Here is the code I have so far:

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

Like I said, I don't want the CSV file to open while they are working. I would like this behind the scenes so they can keep working while we gather the data.

I'm guessing my biggest hang up is that it's a CSV file, that or that the file is not open. If there's a way this can be done, please let me know. Currently, I am getting an out of range error.

Upvotes: 1

Views: 36389

Answers (1)

chancea
chancea

Reputation: 5958

Assuming that you want to just grab the data and put it in your current workbook. I recorded a macro using the Data -> Import Data method and in VBA and it seems to work with the CSV file closed:

Print to consecutive column:

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

Print to consecutive row:

Here we have to add

Dim row As Integer
    row = 1
    On Error Resume Next

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

and then instead of: Destination:=Range("$A$1") we use the row variable: 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

This will grab all of the CSV data and put it in A1 you can change the $A$1 to whatever location you want. Of course you can change all of the other variables also, I just recorded the macro and edited the strConnection variable to match the location you described in your question.

Hopefully this is what you are looking for, if not let me know.

Upvotes: 4

Related Questions