|
Modules: Exporter une feuille Excel en format de fichier CSV |
Author(s) Dev Ashish |
|
--- Soumis par Dev Ashish ---
Exporter une feuille Excel en format de fichier CSV.
Parfois, il est nécessaire d'utiliser Excel pour
formater des données brutes provenant de bases de données de macro-ordinateur
(mainframe). Une fois le traitement de formatage appliqué, la table peut
être importée en Access comme table native. Dans la plupart des cas, ces
fichiers contiendront un grand nombre d'enregistrements et créer une table
locale n'est pas toujours propice, tout spécialement si vous n'avez que des
possibilités de lire les données.
Excel peut être utilisé pour sauvegarder une feuille en un
fichier CSV qui peut alors être attaché (lié) à Access de par le pilote
(driver) Text ISAM. Cependant, Excel n'inclus pas toujours les
guillemets autour des valeurs lorsque sauvegardé en en fichier CSV file (un
nombre sera écrit sans les guillemets). Il est alors requis de traverser
les colonnes et les lignes de la feuille pour exporter les données en utilisant
les fonctions VBA.
Voici une fonction générique qui accepte une référence
à une feuille Excel (que vous aurez pris soin d'ouvrir par Automation) ainsi
que le chemin du fichier de destination CSV. Vous pouvez appeler cette
fonction, depuis votre code, comme suit:
With objXL
.Visible = True
.Workbooks.OpenText FileName:=strFile, Origin:= _
xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, _
Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 2), _
Array(2, 2), Array(3, 2), Array(4, 2))
Set objWkb = .Workbooks(1)
Call fExportCommaDelimitedFile(objWkb.Worksheets(1), fFileDir(strFile) & _
fFileName(Dir(strFile)) & ".csv")
Function fExportCommaDelimitedFile(objSht As excel.Worksheet, _
strDestinationFile As String) _
As Boolean
Dim intFileNum As Integer
Dim lngColCount As Long
Dim lngTotalColumns As Long
Dim lngTotalRows As Long
Dim lngRowCount As Long
Const conQ = """"
Const conERR_GENERIC = vbObjectError + 2100
intFileNum = FreeFile()
On Error GoTo ErrHandler
Call sAppActivate
If Len(Dir(strDestinationFile)) > 0 Then
If MsgBox("The target file specified " & vbCrLf & vbCrLf _
& strDestinationFile & vbCrLf & vbCrLf & " already exists." _
& vbCrLf & vbCrLf & "Are you sure you want to overwrite it?", _
vbQuestion + vbYesNo, "Please confirm") = vbYes Then
Kill strDestinationFile
Else
Err.Raise conERR_GENERIC
End If
End If
Open strDestinationFile For Output As #intFileNum
With objSht
lngTotalColumns = .UsedRange.Columns.Count
lngTotalRows = .UsedRange.Rows.Count
Call SysCmd(acSysCmdInitMeter, "Writing CSV file...", lngTotalRows)
For lngRowCount = 1 To lngTotalRows
For lngColCount = 1 To lngTotalColumns
Print #intFileNum, conQ & RTrim$(.Cells(lngRowCount, lngColCount).Value) & conQ;
If lngColCount = lngTotalColumns Then
Print #intFileNum,
Else
Print #intFileNum, ",";
End If
Next lngColCount
Call SysCmd(acSysCmdUpdateMeter, lngRowCount)
DoEvents
Next lngRowCount
End With
fExportCommaDelimitedFile = True
ExitHere:
On Error Resume Next
Call SysCmd(acSysCmdRemoveMeter)
Close #intFileNum
Exit Function
ErrHandler:
fExportCommaDelimitedFile = False
Resume ExitHere
End Function
Private Sub sAppActivate()
Dim strCaption As String
On Error Resume Next
strCaption = Application.CurrentDb.Properties("AppTitle")
If Err Then strCaption = "Microsoft Access"
AppActivate strCaption
End Sub
|