VBA Copie de données d'un fichier CSV non ouvert vers la feuille de calcul sans ouvrir le fichier CSV fermé

Question

Je crois avoir un problème unique car je n'ai rien vu de tel sur Internet. Je suis un analyste d'affaires/développeur d'applications et je veux recueillir automatiquement les données du fichier Excel CSV d'un autre utilisateur sur leur ordinateur personnel sans ouvrir le fichier et les perturber. Y a-t-il un moyen?

Voici le code que j'ai jusqu'à présent:

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 

Comme je l'ai dit, je ne veux pas le fichier CSV à ouvrir pendant qu'ils travaillent. Je voudrais que ce soit dans les coulisses afin qu'ils puissent continuer à travailler pendant que nous recueillons les données.

Je suppose que mon plus gros problème est que c'est un fichier CSV, ou que le fichier n'est pas ouvert. S'il y a un moyen de le faire, s'il vous plaît faites le moi savoir. Actuellement, je reçois une erreur hors plage.

Answer 1

En supposant que vous souhaitez simplement récupérer les données et les placer dans votre classeur actuel. J'ai enregistré une macro à l'aide des données -> méthode d'importation de données et dans VBA et il semble fonctionner avec le fichier CSV fermé:

Imprimer la colonne consécutive:

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 

Imprimer ligne consécutive:

nous avons ici pour ajouter

Dim row As Integer 
    row = 1 
    On Error Resume Next 

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

puis instea d de: Destination:=Range("$A$1") nous utilisons la variable de ligne: 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 

Cela va récupérer toutes les données CSV et le mettre dans A1 vous pouvez changer le $A$1 à tout endroit où vous voulez. Bien sûr, vous pouvez également changer toutes les autres variables, j'ai simplement enregistré la macro et édité la variable strConnection pour correspondre à l'emplacement que vous avez décrit dans votre question.

J'espère que c'est ce que vous cherchez, si ce n'est pas le cas.