Fournisseur OLEDB Jet de travail partout, sauf Excel 2010 sur Windows 7 64-bit

Je ne sais pas si ce sera utile aux personnes en dehors de mon exemple précis. J'ai été en utilisant le fournisseur pour effectuer une requête sur un fichier CSV. Par exemple:

SELECT C7, 0.0001, (C2+C4*10000000) FROM (filename)

Ici, le fichier source a été modifié, de sorte que toutes les colonnes sont nommées Cn par leurs en-têtes:

csvColumns = UBound(Split(lineIn, Delimiter)) + 1
For icol = 1 To csvColumns: columnLine = columnLine & "C" & icol & Delimiter: Next icol

Donc dans mon cas, j'ai un fichier qui ressemble à ça:

C1       C2       C3       C4       C5       C6       C7
1234     654332   23.214   5432     12345    123      60918234.234
2345     876332   43.223   6534     23456    234      34958732.432
3456     987332   54.243   7654     34567    345      92645378.564

Normalement, en utilisant le fournisseur OLEDB Jet, au-dessus de la chaîne de requête peut être utilisé pour lire le contenu du fichier dans une cellule:

On Error GoTo PoviderError
With Conn
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .Mode = adModeRead
    .ConnectionString = "Data Source=" & path & ";Extended Properties='text;HDR=YES;FMT=Delimited'"
    .Open
End With
Rst.Open "SELECT " & selectText & " FROM [" & file & "];", Conn, adOpenKeyset, adLockOptimistic, adCmdText
If Not Rst.EOF Then Destination.CopyFromRecordset Rst

Mais dans le code ci-dessus "ProviderError" va se déclencher sur 64 bits machines car il n'y a pas de Jet fournisseur. Ma solution a été comme suit. J'ai fait charger le fichier dans excel, et d'analyser la chaîne de requête de moi-même. Je casse la chaîne de requête par des virgules, de sorte que chaque section de la chaîne de requête devient la formule pour une nouvelle cellule. Pour créer la formule, j'ai simplement ajouter un = de signer et de remplacer la chaîne "Cn" avec une référence à la colonne source. De cette façon, les requêtes complexes, comme (C2+C4*10000000) encore évaluée. J'ai ensuite recopier la formule en fonction de la longueur de la source de données, puis de remplacer les formules avec des valeurs codées en dur. Le résultat final est identique pour faire un complexe Jet OLEDB requête, quoique légèrement plus lent. Le Code est ci-dessous.

PoviderError:
    Resume FailOver 'Resets the error state so that further errors can be thrown
FailOver:
    FileReadFailover fixedFile, Destination, selectText, Delimiter
    ...

Private Sub FileReadFailover(ByVal fName$, ByRef Dest As Range, ByVal inputs$, ByVal delim$)
    Dim newBook As Workbook
    Dim pos(0 To 2) As Integer, col(0 To 2) As String
    Dim referenceText As String, i As Integer

    'Parse the query string 'inputs'
    pos(0) = 0: pos(1) = InStr(pos(0) + 1, inputs, ","): pos(2) = InStr(pos(1) + 1, inputs, ",")
    col(0) = Trim(Mid(inputs, pos(0) + 1, pos(1) - pos(0) - 1))
    col(1) = Trim(Mid(inputs, pos(1) + 1, pos(2) - pos(1) - 1))
    col(2) = Trim(Mid(inputs, pos(2) + 1))

    Application.StatusBar = Application.StatusBar & " Missing Jet Provider, waiting for Excel to open file..."
    Application.ScreenUpdating = True 'Allow excel to display the status bar showing the file loading
    Application.Workbooks.OpenText Filename:=fName, DataType:=xlDelimited, Other:=True, OtherChar:=delim
    Set newBook = Application.ActiveWorkbook
    Application.ScreenUpdating = False
    If newBook Is Nothing Then Err.Raise 1, , "User Cancelled Load"

    'Create a formula that will pull the values from the external file just opened.
    referenceText = Replace(newBook.Sheets(1).Cells(1, 1).Address(, , , True), "$A$1", "R[" & 2 - Dest.row & "]C")
    For i = 0 To 2
        If InStr(1, col(i), "C") Then col(i) = "=" & Replace(col(i), "C", referenceText)
        Dest.Offset(0, i).FormulaR1C1 = col(i)
    Next i
    'Copy the formulae down the based on the length of the input file
    Dest.Worksheet.Range(Dest, Dest.Offset(0, 2)).Copy _
        Dest.Worksheet.Range(Dest.Offset(1), Dest.Offset(newBook.Sheets(1).UsedRange.Rows.Count - 2, 2))
    'Make sure the worksheet recalculates to pull the values
    If Application.Calculation = xlCalculationManual Then Dest.Worksheet.Calculate
    'Now overwrite the formulas that pull the values with the values themselves
    Dest.Worksheet.Range(Dest, Dest.Offset(0, 2).End(xlDown)).Copy
    Dest.Worksheet.Range(Dest, Dest.Offset(0, 2).End(xlDown)).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    Application.StatusBar = "File Import Successful"

    newBook.Close (False)
End Sub

La solution ci-dessus suppose une requête avec 3 colonnes, mais pourrait facilement être ajustée afin de prendre une toute requête, l'utilisation de split pour obtenir autant de colonnes qu'il y a, et de façon dynamique redim (pos) et le col() des tableaux.