Discussion :

[phoon]

Bonjour
Depuis Access, je dois modifier un fichier .txt (supprimer la 1èe et la dernière ligne). Comme je n'y arrivais pas, j'ai utiliser un subterfuge.
Depuis Access J'ouvre Excel et depuis Excel, je charge le fichier .txt, le modifie et le sauve....
Le problème est que si je change les chemins, je suis embété.

Le code dans Access :

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
 
Sub ModifieFichierTexte()
 
Dim Xl As Excel.Application
Dim Chemin, Message, Titre
Dim Classeur As Excel.Workbook
Dim Feuille As Excel.Worksheet
 
If existeFileFSO(CheminImport) = False Then GoTo ERRModifieFichierTexte
 
 
'Ouvre Excel et le fichier (avec un macro autorun)
Set Xl = New Excel.Application
Xl.Visible = False
Set Classeur = Xl.Workbooks.Open(CheminImport) 'Classeur.Close False : Se close directement dans la macro Excel
'Xl.Quit : Se Ferme directement dans la macro Excel
End Sub

La ligne bleu passe le chemin du fichier Excel
J'aimerais passer ce chemin depuis Acces directement dans Excel
C'est à dire les ligne bleu dans le code ci-dessous :
Le code Excel

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
 
ChDir "X:\ULPG1_MGMT\Vollständigkeitskontrolle\Host Data"
Workbooks.OpenText Filename:= _
"X:\ULPG1_MGMT\Vollständigkeitskontrolle\Host Data\HostData.txt", Origin:= _
xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
TrailingMinusNumbers:=True
'Rows("1:1").Delete Shift:=xlUp
'Range("A1").Select
If Left(ActiveCell.Value, 1) = "E" Then
Rows("1:1").Delete Shift:=xlUp
End If
Selection.End(xlDown).Select
If Len(ActiveCell.Value) = 1 Then
MyRow = ActiveCell.Row
Rows(MyRow).Delete Shift:=xlUp
End If
Range("A1").Select
ActiveWorkbook.Save
ActiveWorkbook.Close SaveChanges:=False
'ActiveWorkbook.Close SaveChanges:=False
DisplayAlerts = False
Application.Quit

Merci d'avance pour votre aide

[Access Newbie]

Bonjour,

Essayez ce code pour supprimer des lignes dans un fichier texte

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
Function DelAndRenameTxt(fullPath As String, nbLineToDel As Long) As String
'supprime les nbLineToDel premieres lignes d'un fichier texte,
'le renomme et retourne le nom du fichier modifie
'necessite la bibliotheque "Microsoft scripting runtime"
 
On Error GoTo ErrDelAndRenameTxt
 
    Dim str As String
    Dim file As String
    Dim ligne As String
    Dim strFile As String
    Dim Fs As FileSystemObject
    Dim ts As TextStream
    Dim i As Integer
    Dim result As Variant
    Dim entree As Integer
    Dim sortie As Integer
    Dim nb As Integer
    Dim ext As String
 
    entree = FreeFile
 
 
        'recuperation de l'extension du fichier
        ext = FileName(fullPath)
        result = Split(ext, ".")
        ext = result(UBound(result))
 
        'preparation du fichier pour lecture
        strFile = Left(fullPath, Len(fullPath) - 4) & "_copy." & ext
        Open fullPath For Binary As entree
 
        'saut des premieres lignes et copie du reste du fichier
        sortie = FreeFile
        Open strFile For Output As sortie
        i = 1
 
        Do While Not EOF(entree)
            Line Input #entree, ligne
                If i > nbLineToDel Then
                    Print #sortie, ligne
                End If
                i = i + 1
        Loop
 
        Close entree
        Close sortie
 
        DelAndRenameTxt = strFile
        Exit Function
 
ErrDelAndRenameTxt:
    MsgBox err.Number & vbCrLf & vbCrLf & err.Description, vbCritical
 
End Function

PS : il faut rajouter la référence "Microsoft scripting runtime"

[phoon]

Hello newbie

Merci pour ton code
J'ai juste un problème d'appel de ta fonction
- Function DelAndRenameTxt(fullPath As String, nbLineToDel As Long) As String

Je fais :
MyText = DelAndRenameTxt("ULPG1_MGMT\Vollständigkeitskontrolle\Host Data\Hostdata.txt" , 1)

mais j'ai une erreur.... 13 - incompatibilité de type
Je ne saisi pas

merci pour ton aide

[Access Newbie]

Bonjour,

Il faut spécifier le disque sur lequel se situe les données ( C:\MonDossier\MonFichierTexte.txt )

[phoon]

Merci Newbie

Je suis désolé, mais j'ai toujours des problèmes.

J'appelle la fonction comme cela depuis un bouton
code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Sub testtest_Click()
Dim MyText
MyText = DelAndRenameTxt("x\ULPG1_MGMT\Vollständigkeitskontrolle\Host Data\Hostdata.txt", 1)
End Sub

J'ai ton code :

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
 
Function DelAndRenameTxt(fullPath As String, nbLineToDel As Long) As String
'supprime les nbLineToDel premieres lignes d'un fichier texte,
'le renomme et retourne le nom du fichier modifie
'necessite la bibliotheque "Microsoft scripting runtime"
 
On Error GoTo ErrDelAndRenameTxt
 
 
    Dim str As String
    Dim file As String
    Dim ligne As String
    Dim strFile As String
    Dim Fs As FileSystemObject
    Dim ts As TextStream
    Dim i As Integer
    Dim result As Variant
    Dim entree As Integer
    Dim sortie As Integer
    Dim nb As Integer
    Dim ext As String
 
    entree = FreeFile
 
 
        'recuperation de l'extension du fichier
        ext = FileName(fullPath)
        result = Split(ext, ".")
        ext = result(UBound(result))
 
        'preparation du fichier pour lecture
        strFile = Left(fullPath, Len(fullPath) - 4) & "_copy." & ext
        Open fullPath For Binary As entree
 
        'saut des premieres lignes et copie du reste du fichier
        sortie = FreeFile
        Open strFile For Output As sortie
        i = 1
 
        Do While Not EOF(entree)
            Line Input #entree, ligne
                If i > nbLineToDel Then
                    Print #sortie, ligne
                End If
                i = i + 1
        Loop
 
        Close entree
        Close sortie
 
        DelAndRenameTxt = strFile
        Exit Function
 
ErrDelAndRenameTxt:
    MsgBox Err.Number & vbCrLf & vbCrLf & Err.Description, vbCritical
 
End Function

Et quand je le déclenche, j'ai toujours une erreur sur le terme :
- ext = FileName(fullPath)

Erreur de compilation
Sub ou Function non défine

Je ne vois pas pourquoi !

Merci d'avance pour ton aide

[Access Newbie]

Bonjour,

ajoute cette fonction

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
 
Function FileName(strFullPath As String) As String
'retoune un nom de fichier en fonction de son chemin complet
 
Dim result As Variant
 
result = Split(strFullPath, "\")
FileName = result(UBound(result))
 
End Function

Ca devrait aller mieux

PS : t'es sur de ton chemin ?
x\ULPG1_MGMT\Vollständigkeitskontrolle\Host Data\Hostdata.txt
ca serait pas plutot
x:\ULPG1_MGMT\Vollständigkeitskontrolle\Host Data\Hostdata.txt
???

[phoon]

merci pour la réponse

pour le chemin, tu as raison, j'ai oublié le : devant le x:\

Là je n'ai plus d'erreur.
Je contrôle l'effet sur mon fichier texte.
le but étant d'effacer la première et la dernière.

je te tiens au courant.
Encore merci

[Access Newbie]

ca ne supprimera pas la derniere c'est sur. Soit tu essaie d'adapter le code, soit tu supprime la derniere ligne de ton fichier apres avoir fait ton import.

[phoon]

Hello
Ton code fonctionne, c'est super,
Pour la dernière ligne en effet cela ne la supprime pas.
Mais cela je pense qu'il est possible avec une petite modification de la supprimer.

Il y a un autre effet bizarre :
La première ligne est bien supprimée, mais le format du fichier aussi ..

Le fichier avant :

ELKB VK FEHLENDE, NICHT GESCANNTE;
AUFTRAGSNUMMER;ZEIT;EINLIEFERUNGSDATUM ELAR;BUID;BKST;KASSE-NR;PID KASSIER;KONTO-ART;BUCHUNGS-TYP;BUCHUNGS-BETRAG;
AA0D0904150419999;1632;16.04.2009;0005;0594;0001;A888575; ; ; 00000000000000000000000.00000000;
AA0D0904170410014;1036;18.04.2009;0005;0594;0001;A227580; ; ; 00000000000000000000000.00000000;
AA0D0904210419999;1635;22.04.2009;0005;0594;0001;A659274; ; ; 00000000000000000000000.00000000;
AA0D0904240410003;0835;25.04.2009;0005;0594;0001;A659274; ; ; 00000000000000000000000.00000000;
AA0D0904240410008;0945;25.04.2009;0005;0594;0001;A659274; ; ; 00000000000000000000000.00000000;
AA0D0904270410024;1007;28.04.2009;0005;0594;0001;A659274; ; ; 00000000000000000000000.00000000;
AA0D0904270410025;1015;28.04.2009;0005;0594;0001;A659274; ; ; 00000000000000000000000.00000000;
AA0D0904270410026;1024;28.04.2009;0005;0594;0001;A659274; ; ; 00000000000000000000000.00000000;
AA0D0904270410027;1025;28.04.2009;0005;0594;0001;A659274; ; ; 00000000000000000000000.00000000;
AA0D0904270419999;1644;28.04.2009;0005;0594;0001;A659274; ; ; 00000000000000000000000.00000000;
AA7A0903300419999;1701;31.03.2009;0005;0175;0003;A402986; ; ; 00000000000000000000000.00000000;
AA7A0904090410072;1447;10.04.2009;0005;0175;0003;A439952; ; ; 00000000000000000000000.00000000;

Le fichier après

AUFTRAGSNUMMER;ZEIT;EINLIEFERUNGSDATUM ELAR;BUID;BKST;KASSE-NR;PID KASSIER;KONTO-ART;BUCHUNGS-TYP;BUCHUNGS-BETRAG;
AA0D0904150419999;1632;16.04.2009;0005;0594;0001;A888575;
;
; 00000000000000000000000.00000000;
AA0D0904170410014;1036;18.04.2009;0005;0594;0001;A227580;
;
; 00000000000000000000000.00000000;
AA0D0904210419999;1635;22.04.2009;0005;0594;0001;A659274;
;
; 00000000000000000000000.00000000;
AA0D0904240410003;0835;25.04.2009;0005;0594;0001;A659274;
;
; 00000000000000000000000.00000000;
AA0D0904240410008;0945;25.04.2009;0005;0594;0001;A659274;
;
; 00000000000000000000000.00000000;
AA0D0904270410024;1007;28.04.2009;0005;0594;0001;A659274;
;
; 00000000000000000000000.00000000;
AA0D0904270410025;1015;28.04.2009;0005;0594;0001;A659274;
;
; 00000000000000000000000.00000000;
AA0D0904270410026;1024;28.04.2009;0005;0594;0001;A659274;
;
; 00000000000000000000000.00000000;

[tom@tom]

je reviens sur ton post initial, pourquoi tu ne mettrai pas tout le code dans access, en ajoutant en référence "Microsoft Excel xx object Library" ?

comme ça tu n'as pas de problème pour passer tes arguments.

[phoon]

Hello Access newbie

J'ai légérement modifié ton code

Do While Not EOF(entree)
Line Input #entree, ligne
If i > nbLineToDel Then
If ligne <> "" Then
Print #sortie, ligne
End If
End If
i = i + 1
Loop

Comme cela la dernière ligne qui est toujours fixe n'est pas prise.
Mais a chaque espace, cela me crée une "fin de ligne".

Je cherche, mais pour le moment je coince,
C'est comme l'instruction Line Input prenait l'espace pour une fin de ligne...