Dim Message, Style, Titre
Dim DossierCsv, K As String
i = 0
On Error GoTo fin
Sheets("HOME").Select
Columns("K:K").Select
Selection.ClearContents
Message = "Please specify the folder containing the CSV files" & vbCrLf & "Press OK to select the folder"
Style = vbOK
Titre = "Importation CSV"
Response = MsgBox(Message, Style, Titre)
If Response = vbOK Then ' L'utilisateur a choisi OK.
Application.FileDialog(msoFileDialogFolderPicker).Show
DossierCsv = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
'Arrêt du rafraichissement de lécran(metre true à la fin de la macro.
Application.ScreenUpdating = False
'Incrementation du numero de fichier.
For i = 0 To 60
varnomfichier = "SA0000" & i
If i >= 10 Then
varnomfichier = "SA000" & i
End If
If i >= 100 Then
varnomfichier = "SA00" & i
End If
Sheets(varnomfichier).Select
'Destignation à la ligne trouvé précèdement.
K = "$A$3"
'Importation du fichier préselectionné à la place prédefini.
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & DossierCsv & "\" & varnomfichier & ".csv", _
Destination:=Range(K))
.Name = varnomfichier
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(5, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
'Apres importation, on supprime la premier ligne du fichier contenant le nom des colonnes.
Rows(3).Select
Selection.Delete Shift:=xlUp
'Extraire sans doublon
'Columns("R:R").Select 'vider la colonne pour extraire
'Selection.ClearContents
'J = 3
' valcell = ActiveSheet.Range("R3").Value 'valcell est la valeur de la celule precedente
'For Nbligne = 3 To 10004
' valligne = Cells(Nbligne, 1)
' If valligne <> valcell Then
' valcell = valligne
' numcell = "R" & J
' Range(numcell).Formula = valcell
' J = J + 1
' End If
' If valligne = "" Then Exit For
'Next Nbligne
'copier la liste des dates sur la feuille acceuil
'Range("R3:" & numcell).Select
'Selection.Copy
'Sheets("HOME").Select
'NBdate = Cells(1, 13)
'NBdate = NBdate + 1
'Range("K" & NBdate).Select
'ActiveSheet.Paste
Next i
End If
fin:
Sheets("HOME").Select
MsgBox ("Number of imported files :" & i)
End Sub
)
