Bonjour,
Tout d'abord j'aimerai remercier SilkyRoad pour le partage de sa base de connaissance, et tout particulièrement la lecture et l'écriture dans les fichiers fermés.
J'utilise de plus en plus cette méthode dans mes développements de reporting avec la programmation de TCD et graphiques temporaires.
Cependant j'ai une question à laquelle je ne trouve pas de réponse.
Je me suis créé une petite fonction générique pour importer mes données à partir d'un fichier Xlsx. bien entendu ce fichier est structuré en base de données( Titre de colonne sur la ligne 1, mots courts, pas d'espace, pas de caractères accentués, pas de signes opératoires, et pas de caractères spéciaux)

Les arguments de la fonction sont:
P$ Path,
ff$ FileFrom,
wsf SheetFrom,
r Row ( ligne à partir de à laquelle on veut placer les données importées),
c Column (colonne à partir de la quelle on veut placer les données importées),
mFolder Optional Répertoire principal (\\Path\mFolder\),
sFolder Optional Sous-répertoire (\\Path\mFolder\SFolder),
Optional Clearcontents: si Vrai, Suppression des données éventuellement présentes dans la feuille qui va recevoir les données,
rg$ nom du champ qui sera supprimé si Optional Clearcontents: = Vrai,
La fonction Function X1cFileExists(f$) As Boolean permet tester si le fichier que l'on veut importer existe


Tout cela fonctionne très bien, mais le problème est le suivant.
si dans une des colonne une cellule contient du texte de plus de 255 caratères et que cette cellule se situe dans les 8 premières lignes du fichier importé alors tout va bien, et on pourra importer du texte de plus de 255 caratères dans les cellules de cette colonne.
si dans les 8 premières lignes de notre fichier à importer aucune cellule ne possède de texte de plus de 255 caractères, alors la dimension est figée à maximum 255 caractères pour toutes les cellules de cette colonne.

Savez-vous comment faire en sorte que le nombre de caractères ne soit pas limité, en utilisant cette méthode d'importation?
Un grand merci à ceux qui pourrons orienter mes recherches ou me donner la solution.

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
Function X1cImportDataXlsx(P$, ff$, wsf$, wst$, r&, c&, Optional mFold$, Optional sFold$, Optional ClearContent As Boolean, Optional rg$)
'99.21-Set Parameter to import Data From Xlsx File (XlOneClick: G.Charrault  Inspiration:  SilkyRoad)
    Dim i As Integer
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim cn As ADODB.Connection
    Dim SQLText As String
    Dim rst As ADODB.Recordset
    Dim XlsxFileFrom As String
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets(wst)
    FileFrom = ff
    If Len(FileFrom) < 5 Then FileFrom = FileFrom & ".xlsx"
    If UCase(Right(FileFrom, 5)) <> ".XLSX" Then FileFrom = FileFrom & ".xlsx"
    XlsxFileFrom = ""
    If Right(P, 1) <> "\" Then P = P & "\"
    If mFold <> "" Then
        If Right(mFold, 1) <> "\" Then P = P & mFold & "\"
    End If
    If sFold <> "" Then
        If Right(sFold, 1) <> "\" Then P = P & sFold & "\"
    End If
    XlsxFileFrom = P & FileFrom 'XlsxFile FullFileName
    If X1cFileExists(XlsxFileFrom) = False Then
        MsgBox ("file is not existing")
        ErrorExit = True
        Exit Function
    End If
    If ClearContent = True Then
        ws.Select
        ws.Cells.ClearContents
    Else
        Do While ws.Cells(r, c) <> ""
            r = r + 1
        Loop
    End If
    Set cn = New ADODB.Connection
    'Code to connect Xlsx File (2007-2010)
    With cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
            & XlsxFileFrom & ";Extended Properties=""Excel 12.0;HDR=YES;"""
        .Open
    End With
 
  ' ----Une case à cocher ou checkBox (Chb_Message) dans une feuille Name: wsMenu qui permet d'afficher le chemin complet du fichier pour un debugging----
  ' If wsMenu.Chb_Message.Value = True Then MsgBox ("Import xlsx File From: " & XlsxFileFrom & Chr(10) & Chr(13) _
  '                                                  & "SheetFrom: " & wsf & Chr(10) & Chr(13) _
  '                                                   & "SheetTo: " & wst & Chr(10) & Chr(13))
  '                                                 
 
    SQLText = "SELECT * FROM [" & wsf & "$]"
    Set rst = New ADODB.Recordset
    Set rst = cn.Execute(SQLText)
    For i = 0 To rst.Fields.Count - 1
        ws.Cells(r, c + i) = rst.Fields(i).Name
    Next i
    ws.Cells(r + 1, c).CopyFromRecordset rst
    cn.Close
 
    Set rst = Nothing
    Set wb = Nothing
    Set cn = Nothing
    Set ws = Nothing
 End Function
 
Function X1cFileExists(f$) As Boolean
'99.13-Test If File Exist (XlOneClick: G.Charrault)
'This function will test and return a boolean if the xml file exist
    X1cFileExists = Dir(f) <> ""
End Function