--- Soumis par Dev Ashish ---

Exporter une feuille Excel en format de fichier CSV.

     Parfois, il est nécessaire d'utiliser Excel pour formatter des données brutes originant de bases de données de macroordinateur (mainframe).  Une fois le traitement de formattage 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 utilsé poursauvegarder 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 guillements autour des valeurs lorsque sauveagrdé en en fichier CSV file (un nombre sera écrit sans les guillements).  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")

 

'*********************** Code Start ***************************
Function fExportCommaDelimitedFile(objSht As excel.Worksheet, _
                              strDestinationFile As String) _
                                As Boolean
'*******************************************
'Nom:      fExportCommaDelimitedFile (Function)
'But: 	Écrire une feuille en format CSV
'Auteur:   	Dev Ashish
'Date:        March 10, 1999, 12:21:10 PM
'Called by: Any
'Calls:        sAppActivate
'Inputs:      objSht - Feuille Excel déjà ouverte, par automation
'                 strDestinationFile - Chemin de la destionation pour le fichier CSV
'Output:    True si tout est correct,  false autrement
'*******************************************
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
  
  'Active l'instance d'Access
  Call sAppActivate
  
  'Si le fichier cible existe, demander confirmation avant d'écraser
  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
   
  'Créer le fichier CSV
  Open strDestinationFile For Output As #intFileNum
         
  With objSht
    'Déterminer le nombre de colonnes
    lngTotalColumns = .UsedRange.Columns.Count
    'Déterminer le nombre de lignes
    lngTotalRows = .UsedRange.Rows.Count
    'Initialiser le thermomètre de progression
    Call SysCmd(acSysCmdInitMeter, "Writing CSV file...", lngTotalRows)
    
    'Traverser toutes les lignes
    For lngRowCount = 1 To lngTotalRows
      ' et chaque colonne
      For lngColCount = 1 To lngTotalColumns
        ' Écrire le texte de la cellule, avec guillements
        Print #intFileNum, conQ & RTrim$(.Cells(lngRowCount, lngColCount).Value) & conQ;
        ' Vérifier si c'est la dernière colonne
        If lngColCount = lngTotalColumns Then
          'la fin
          Print #intFileNum,
        Else
          ' autrement, ajouter une virgule
          Print #intFileNum, ",";
        End If
      Next lngColCount
      Call SysCmd(acSysCmdUpdateMeter, lngRowCount)
      'Ne pas mobiliser le CPU 
      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()
'Active l'intance d'Access
'
Dim strCaption As String
  On Error Resume Next
  strCaption = Application.CurrentDb.Properties("AppTitle")
  If Err Then strCaption = "Microsoft Access"
  AppActivate strCaption
End Sub
'*********************** Code End ***************************