ATOUTFOX
COMMUNAUTÉ FRANCOPHONE DES PROFESSIONNELS FOXPRO
Visual FoxPro : le développement durable

Exporter une table DBF en csv afin de ne plus avoir la limite des champs memo et du nb de lignes   



L'auteur

Olivier Hamou
France France
Membre Simple
# 0000000017
enregistré le 13/10/2004
http://www.planitron.com
Hamou Olivier
94100 Saint Maur des fossés
de la société PLANITRON
Fiche personnelle


Note des membres
pas de note

Contributions > 01 - PRG : Programmation > Conversions

Exporter une table DBF en csv afin de ne plus avoir la limite des champs memo et du nb de lignes
# 0000000488
ajouté le 26/10/2007 10:24:11 et modifié le 26/10/2007
consulté 10901 fois
Niveau débutant

Version(s) Foxpro :
VFP 9.0

Description
Il suffit juste de lancer la fonction

Select MaTABLE
=EXPORT_CSV("c:\monfichier.csv",";")
Code source :
*===============================================================
* Procedure qui crée un fichier csv avec un séparateur de texte.
* Auteur     : Hamou Olivier
* crée le     : 01/01/1999
* modifié le   : 10/11/2006 10:52:00
*===============================================================
Function EXPORT_CSV
  LPARAMETERS FIC_CSV,SEPARATEUR
  Local CHAMPS as String
        *====================================
        * Conseils pour le publipostage uniquement
        *====================================
  * Attention si vous mettez des virgules pour les separateurs cela pose probleme
  * dans certain word97 il faut mettre des points virgules.
  * le publipostage par defaut pour tous les words est TXT avec virgule donc à traiter
  * a la place du csv au point virgule.
        * autre Astuce: j'ai mis en commentaire pour les type Char et Memo les
        * strtran(var,chr(13),chr(11))
        * je remplace les sauts de lignes par un chr(11) afin que le saut de ligne apparaisse
        * sous word publipostage
        *====================================

  If Empty(M.SEPARATEUR)
    M.SEPARATEUR = ";"
  EndIF

  Local FIC_TMP,i,j
  IF EMPTY(M.FIC_CSV)
    MESSAGEBOX("Le nom de fichier n'est pas renseigné."+CHR(13)+;
    "La creation du fichier csv ne peut pas se faire.",0+32,"information")
    RETURN .F.
  EndIF
  IF FILE(M.FIC_CSV)
    DescFic = fopen(M.FIC_CSV,12)
    If DescFic <> -1
      FCLOSE(DescFic)
    EndIF
    If DescFic=-1
      MESSAGEBOX("La création du fichier <CSV> ne peut se faire."+CHR(13)+;
      "Veuillez verifier que le fichier n'est ouvert par une autre application .",0+32,"information")
      RETURN .F.
    Endif

  EndIF

  SELECT(ALIAS())

  Set safety OFF
  Set console OFF
  SET ALTERNATE TO LOWER(M.FIC_CSV)
  SET ALTERNATE ON

  M.CHAMPS=""

  *================================
  * Création de l'en tête du fichier Texte
  *================================
  For i=1 to Fcount()
    M.CHAMPS  =field(i)
    _Type  =Type(M.CHAMPS)
    iF !empty(M.CHAMPS)
      If i=fcount()
        ?? alltr(upper(M.CHAMPS))
      Else
        ?? alltr(upper(M.CHAMPS))+M.SEPARATEUR
      EndIf
    EndiF
  EndFor

  *================================
  * Création des enregistrements
  *================================
  Scan
    For i=1 to Fcount()
      M.CHAMPS  =field(i)
      _Type  =alltr(Type(M.CHAMPS))

      Do case
        Case _type == "C"
          Chaine = &Champs
          Chaine = STRTRAN(Chaine,chr(10),"")
                                        Chaine = STRTRAN(Chaine,chr(13)," ")
          && Chaine = STRTRAN(Chaine,chr(13),chr(11))
          M.Champs = '"'+ALLTR(STRTRAN(Chaine,M.SEPARATEUR,[ ]))+'"'
        Case _type == "M"
          Chaine = Eval(Champs)
          Chaine = STRTRAN(Chaine,M.SEPARATEUR,[])
          && La methode pour récuperer chaque ligne est preferable
          && car quelque fois le soft ne recupere pas les chr(13) dans une variable.
          _MEMO  = ""
          FOR j=1 TO MEMLINES(Chaine)
            If ! Empty(Alltr(MLINE(Chaine,j)))
              _MEMO = _MEMO + Alltr(MLINE(Chaine,j))+ Iif(j = MEMLINES(Chaine),"",chr(11))
            EndIF
          EndFOR

          ?? '"'+_MEMO+'"' + M.SEPARATEUR
    *!*        Chaine = STRTRAN(Chaine,chr(10),"")
    *!*        Chaine = STRTRAN(Chaine,chr(13),chr(11)) && chr(11) ce sont les sauts de ligne sous word.
    *!*        M.Champs = '"'+ALLTR(STRTRAN(Chaine,M.SEPARATEUR,[ ]))+'"'
        Case _type == "N"
          M.CHAMPS = alltr(str(&champs))
        Case _type == "L"
          M.CHAMPS = Iif(&champs,[T],[F])
        Case _type == "D"
          M.CHAMPS = Dtoc(&champs)
      ENDCASE

      If _type <> "M"
        If i==1
          ? M.CHAMPS+M.SEPARATEUR
        ELSE
          ?? M.CHAMPS+Iif(i=fcount(),"",M.SEPARATEUR)
        EndIf
      EndIF

    EndFor
  EndScan
  SET ALTERNATE TO
  SET CONSOLE ON
  SET ALTERNATE OFF

  FIC_TMP = Filetostr(M.FIC_CSV)
  FIC_TMP = Substr(FIC_TMP,1,len(FIC_TMP)-1)
  Strtofile(FIC_TMP,M.FIC_CSV)
  Return .T.
ENDFUNC
Commentaires
Aucun commentaire enregistré ...

www.atoutfox.org - Site de la Communauté Francophone des Professionnels FoxPro - v3.4.0 - © 2004-2024.
Cette page est générée par un composant COM+ développé en Visual FoxPro 9.0-SP2-HF3