import de data d'un formulaire word vers access.

Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Entraide Applications Microsoft Office Access import de data d'un formulaire word vers access.

13 réponses

sleg

17/09/2008 à 13:10

BOnjour,

j'ai trouver sur ce site "http://heureuxoli.developpez.com/office/
sondage/#L4" l'information que je cherchais mais impossible de lancer
l'extract.

une id=E9e ??

la function :

Public Function Extract(oFN As String)
On Error Resume Next
Dim wApp As New Word.Application
Dim oDoc As Word.Document
Dim rs As DAO.Recordset
Dim sql As String
Dim i As Integer, j As Integer

Set oDoc =3D wApp.Documents.Open(FileName:=3D"\\serveur\rep1\Projet\01
Janvier 2008\" & oFN)

oDoc.Unprotect

i =3D oDoc.FormFields.Count
Debug.Print i
Set rs =3D CurrentDb.OpenRecordset("recup", dbOpenTable)
'=E9dition du jeu d'enregistrement par ajout
rs.AddNew
For j =3D 1 To i
rs.Fields(j) =3D oDoc.FormFields(j).Result

Next j
rs.Fields(j + 1) =3D oFN
rs.Update
oDoc.Close SaveChanges:=3DFalse
rs.Close
Set rs =3D Nothing
Set oDoc =3D Nothing
wApp.Quit

End Function

le second modul :
Public Sub RecupFichier()
Dim oFSO As New FileSystemObject
Dim oFil As File
Dim oFold As Folder
Set oFold =3D oFSO.GetFolder("\\serveur\rep1\Projet\01 Janvier 2008\01
Janvier 2008")
For Each oFil In oFold.Files
If Right(oFil.Name, 4) =3D "doc" Then
Extract (oFil.Name)
oFil.Move "\\serveur\rep1\Projet\01 Janvier 2008\01 Janvier
2008\done\"
End If
Next oFil
Set oFSO =3D Nothing

End Sub

3 réponses

1 2

Michel__D

18/09/2008 à 17:25

Remplace le code de la Sub par celui-ci

Sub RecupFichier()
Dim oFSO As Object
Dim oFil As Object
Dim oFold As Object

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFold = oFSO.GetFolder("d:testfiche")
For Each oFil In oFold.Files
If LCase(Right(oFil.Name, 3)) = "doc" Then
Extract (oFil.Name)
oFil.Move "d:testfichedone" & oFil.Name
End If
Next
Set oFold = Nothing
Set oFil = Nothing
Set oFSO = Nothing
End Sub

sleg a écrit :

voici le code car impossible de retirer "(" donc voici le code .

le code :
Sub RecupFichier()
Dim oFSO As New FileSystemObject
Dim oFil As File
Dim oFold As Folder
Set oFold = oFSO.GetFolder("d:testfiche")
For Each oFil In oFold.Files
If Right(oFil.Name, 4) = "doc" Then
Extract (oFil.Name)
oFil.Move "d:testfichedone"
End If
Next oFil
Set oFSO = Nothing

End Sub

la fonction :
Public Function Extract(oFN As String)
On Error Resume Next
Dim wApp As New Word.Application
Dim oDoc As Word.Document
Dim rs As DAO.Recordset
Dim sql As String
Dim i As Integer, j As Integer

Set oDoc = wApp.Documents.Open(FileName:="d:testfiche" & oFN)

oDoc.Unprotect

i = oDoc.FormFields.Count
Debug.Print i
Set rs = CurrentDb.OpenRecordset("recup", dbOpenTable)
'édition du jeu d'enregistrement par ajout
rs.AddNew
For j = 1 To i
rs.Fields(j) = oDoc.FormFields(j).Result

Next j
rs.Fields(j + 1) = oFN
rs.Update
oDoc.Close SaveChanges:úlse
rs.Close
Set rs = Nothing
Set oDoc = Nothing
wApp.Quit

End Function

On 18 sep, 16:52, Michel__D
wrote:
Tu n'aurais pas oublier ceci :

Dim oFSO As New FileSystemObject
Dim oFil As File
Dim oFold As Folder

Et aussi enlever le "" à la fin de
Set oFold = oFSO.GetFolder("d:testfiche")

Normalement si les librairies sont activées (références cochées)
cela devrait aller mieux.

Et si cela ne va pas donne le code complet utilisé (function et sub).

sleg a écrit :

l'upload de on fichier
http://www.nelty.fr/fichiers/recupzip.zip
lorsque je fais F8 j'ai ces lignes qui apparraissent en jaune.....
*Sub RecupFichier() *
*Set oFold = oFSO.GetFolder("d:testfiche") *
*For Each oFil In oFold.Files*
*If Right(oFil.Name, 4) = "doc" Then*
*End If*
*Next oFil*
merci de ton aide.
On 18 sep, 13:06, Michel__D
wrote:
sleg a écrit :
Non aucun message d'erreur et le pas a pas me donne rien ou je ne sais
pas l'utiliser ...

Tu place le curseur sur n'importe quelle ligne de la Sub RecupFichier()
et tu appuie sur la touche F8 pour l'exécution en pas à pas.
voici mon fichier
http://www.easy-upload.net/fichier.php?fichier 08918123415
merci de votre aide.
On 18 sep, 11:40, Michel__D
wrote:
Bonjour,
Il n'y a pas de message d'erreur ?
Sinon exécuter en pas en pas.
PS:
La Function Extract(oFN As String) est appelé par la Sub RecupFichier()
sleg a écrit :
BOnjour,
j'ai trouver sur ce site "http://heureuxoli.developpez.com/office/
sondage/#L4" l'information que je cherchais mais impossible de lancer
l'extract.
une idée ??
la function :
Public Function Extract(oFN As String)
On Error Resume Next
Dim wApp As New Word.Application
Dim oDoc As Word.Document
Dim rs As DAO.Recordset
Dim sql As String
Dim i As Integer, j As Integer
Set oDoc = wApp.Documents.Open(FileName:="serveurrep1Projet1
Janvier 2008" & oFN)
oDoc.Unprotect
i = oDoc.FormFields.Count
Debug.Print i
Set rs = CurrentDb.OpenRecordset("recup", dbOpenTable)
'édition du jeu d'enregistrement par ajout
rs.AddNew
For j = 1 To i
rs.Fields(j) = oDoc.FormFields(j).Result
Next j
rs.Fields(j + 1) = oFN
rs.Update
oDoc.Close SaveChanges:úlse
rs.Close
Set rs = Nothing
Set oDoc = Nothing
wApp.Quit
End Function
le second modul :
Public Sub RecupFichier()
Dim oFSO As New FileSystemObject
Dim oFil As File
Dim oFold As Folder
Set oFold = oFSO.GetFolder("serveurrep1Projet1 Janvier 20081
Janvier 2008")
For Each oFil In oFold.Files
If Right(oFil.Name, 4) = "doc" Then
Extract (oFil.Name)
oFil.Move "serveurrep1Projet1 Janvier 20081 Janvier
2008done"
End If
Next oFil
Set oFSO = Nothing
End Sub- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -

Remplace le code de la Sub par celui-ci

Sub RecupFichier()
Dim oFSO As Object
Dim oFil As Object
Dim oFold As Object

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFold = oFSO.GetFolder("d:testfiche")
For Each oFil In oFold.Files
If LCase(Right(oFil.Name, 3)) = "doc" Then
Extract (oFil.Name)
oFil.Move "d:testfichedone" & oFil.Name
End If
Next
Set oFold = Nothing
Set oFil = Nothing
Set oFSO = Nothing
End Sub

sleg a écrit :

voici le code car impossible de retirer "(" donc voici le code .

le code :
Sub RecupFichier()
Dim oFSO As New FileSystemObject
Dim oFil As File
Dim oFold As Folder
Set oFold = oFSO.GetFolder("d:testfiche")
For Each oFil In oFold.Files
If Right(oFil.Name, 4) = "doc" Then
Extract (oFil.Name)
oFil.Move "d:testfichedone"
End If
Next oFil
Set oFSO = Nothing

End Sub

la fonction :
Public Function Extract(oFN As String)
On Error Resume Next
Dim wApp As New Word.Application
Dim oDoc As Word.Document
Dim rs As DAO.Recordset
Dim sql As String
Dim i As Integer, j As Integer

Set oDoc = wApp.Documents.Open(FileName:="d:testfiche" & oFN)

oDoc.Unprotect

i = oDoc.FormFields.Count
Debug.Print i
Set rs = CurrentDb.OpenRecordset("recup", dbOpenTable)
'édition du jeu d'enregistrement par ajout
rs.AddNew
For j = 1 To i
rs.Fields(j) = oDoc.FormFields(j).Result

Next j
rs.Fields(j + 1) = oFN
rs.Update
oDoc.Close SaveChanges:úlse
rs.Close
Set rs = Nothing
Set oDoc = Nothing
wApp.Quit

End Function

On 18 sep, 16:52, Michel__D <Michel.NOS...@orange-ft.com.invalid>
wrote:

Tu n'aurais pas oublier ceci :

Dim oFSO As New FileSystemObject
Dim oFil As File
Dim oFold As Folder

Et aussi enlever le "" à la fin de
Set oFold = oFSO.GetFolder("d:testfiche")

Normalement si les librairies sont activées (références cochées)
cela devrait aller mieux.

Et si cela ne va pas donne le code complet utilisé (function et sub).

sleg a écrit :

l'upload de on fichier
http://www.nelty.fr/fichiers/recupzip.zip
lorsque je fais F8 j'ai ces lignes qui apparraissent en jaune.....
*Sub RecupFichier() *
*Set oFold = oFSO.GetFolder("d:testfiche") *
*For Each oFil In oFold.Files*
*If Right(oFil.Name, 4) = "doc" Then*
*End If*
*Next oFil*
merci de ton aide.
On 18 sep, 13:06, Michel__D <Michel.NOS...@orange-ft.com.invalid>
wrote:

sleg a écrit :

Non aucun message d'erreur et le pas a pas me donne rien ou je ne sais
pas l'utiliser ...

Tu place le curseur sur n'importe quelle ligne de la Sub RecupFichier()
et tu appuie sur la touche F8 pour l'exécution en pas à pas.

voici mon fichier
http://www.easy-upload.net/fichier.php?fichier 08918123415
merci de votre aide.
On 18 sep, 11:40, Michel__D <Michel.NOS...@orange-ft.com.invalid>
wrote:

Bonjour,
Il n'y a pas de message d'erreur ?
Sinon exécuter en pas en pas.
PS:
La Function Extract(oFN As String) est appelé par la Sub RecupFichier()
sleg a écrit :

BOnjour,
j'ai trouver sur ce site "http://heureuxoli.developpez.com/office/
sondage/#L4" l'information que je cherchais mais impossible de lancer
l'extract.
une idée ??
la function :
Public Function Extract(oFN As String)
On Error Resume Next
Dim wApp As New Word.Application
Dim oDoc As Word.Document
Dim rs As DAO.Recordset
Dim sql As String
Dim i As Integer, j As Integer
Set oDoc = wApp.Documents.Open(FileName:="\serveurrep1Projet1
Janvier 2008" & oFN)
oDoc.Unprotect
i = oDoc.FormFields.Count
Debug.Print i
Set rs = CurrentDb.OpenRecordset("recup", dbOpenTable)
'édition du jeu d'enregistrement par ajout
rs.AddNew
For j = 1 To i
rs.Fields(j) = oDoc.FormFields(j).Result
Next j
rs.Fields(j + 1) = oFN
rs.Update
oDoc.Close SaveChanges:úlse
rs.Close
Set rs = Nothing
Set oDoc = Nothing
wApp.Quit
End Function
le second modul :
Public Sub RecupFichier()
Dim oFSO As New FileSystemObject
Dim oFil As File
Dim oFold As Folder
Set oFold = oFSO.GetFolder("\serveurrep1Projet1 Janvier 20081
Janvier 2008")
For Each oFil In oFold.Files
If Right(oFil.Name, 4) = "doc" Then
Extract (oFil.Name)
oFil.Move "\serveurrep1Projet1 Janvier 20081 Janvier
2008done"
End If
Next oFil
Set oFSO = Nothing
End Sub- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -

Vous avez filtré cet utilisateur ! Consultez son message

Remplace le code de la Sub par celui-ci

Sub RecupFichier()
Dim oFSO As Object
Dim oFil As Object
Dim oFold As Object

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFold = oFSO.GetFolder("d:testfiche")
For Each oFil In oFold.Files
If LCase(Right(oFil.Name, 3)) = "doc" Then
Extract (oFil.Name)
oFil.Move "d:testfichedone" & oFil.Name
End If
Next
Set oFold = Nothing
Set oFil = Nothing
Set oFSO = Nothing
End Sub

sleg a écrit :

voici le code car impossible de retirer "(" donc voici le code .

le code :
Sub RecupFichier()
Dim oFSO As New FileSystemObject
Dim oFil As File
Dim oFold As Folder
Set oFold = oFSO.GetFolder("d:testfiche")
For Each oFil In oFold.Files
If Right(oFil.Name, 4) = "doc" Then
Extract (oFil.Name)
oFil.Move "d:testfichedone"
End If
Next oFil
Set oFSO = Nothing

End Sub

la fonction :
Public Function Extract(oFN As String)
On Error Resume Next
Dim wApp As New Word.Application
Dim oDoc As Word.Document
Dim rs As DAO.Recordset
Dim sql As String
Dim i As Integer, j As Integer

Set oDoc = wApp.Documents.Open(FileName:="d:testfiche" & oFN)

oDoc.Unprotect

i = oDoc.FormFields.Count
Debug.Print i
Set rs = CurrentDb.OpenRecordset("recup", dbOpenTable)
'édition du jeu d'enregistrement par ajout
rs.AddNew
For j = 1 To i
rs.Fields(j) = oDoc.FormFields(j).Result

Next j
rs.Fields(j + 1) = oFN
rs.Update
oDoc.Close SaveChanges:úlse
rs.Close
Set rs = Nothing
Set oDoc = Nothing
wApp.Quit

End Function

On 18 sep, 16:52, Michel__D
wrote:
Tu n'aurais pas oublier ceci :

Dim oFSO As New FileSystemObject
Dim oFil As File
Dim oFold As Folder

Et aussi enlever le "" à la fin de
Set oFold = oFSO.GetFolder("d:testfiche")

Normalement si les librairies sont activées (références cochées)
cela devrait aller mieux.

Et si cela ne va pas donne le code complet utilisé (function et sub).

sleg a écrit :

l'upload de on fichier
http://www.nelty.fr/fichiers/recupzip.zip
lorsque je fais F8 j'ai ces lignes qui apparraissent en jaune.....
*Sub RecupFichier() *
*Set oFold = oFSO.GetFolder("d:testfiche") *
*For Each oFil In oFold.Files*
*If Right(oFil.Name, 4) = "doc" Then*
*End If*
*Next oFil*
merci de ton aide.
On 18 sep, 13:06, Michel__D
wrote:
sleg a écrit :
Non aucun message d'erreur et le pas a pas me donne rien ou je ne sais
pas l'utiliser ...

Tu place le curseur sur n'importe quelle ligne de la Sub RecupFichier()
et tu appuie sur la touche F8 pour l'exécution en pas à pas.
voici mon fichier
http://www.easy-upload.net/fichier.php?fichier 08918123415
merci de votre aide.
On 18 sep, 11:40, Michel__D
wrote:
Bonjour,
Il n'y a pas de message d'erreur ?
Sinon exécuter en pas en pas.
PS:
La Function Extract(oFN As String) est appelé par la Sub RecupFichier()
sleg a écrit :
BOnjour,
j'ai trouver sur ce site "http://heureuxoli.developpez.com/office/
sondage/#L4" l'information que je cherchais mais impossible de lancer
l'extract.
une idée ??
la function :
Public Function Extract(oFN As String)
On Error Resume Next
Dim wApp As New Word.Application
Dim oDoc As Word.Document
Dim rs As DAO.Recordset
Dim sql As String
Dim i As Integer, j As Integer
Set oDoc = wApp.Documents.Open(FileName:="serveurrep1Projet1
Janvier 2008" & oFN)
oDoc.Unprotect
i = oDoc.FormFields.Count
Debug.Print i
Set rs = CurrentDb.OpenRecordset("recup", dbOpenTable)
'édition du jeu d'enregistrement par ajout
rs.AddNew
For j = 1 To i
rs.Fields(j) = oDoc.FormFields(j).Result
Next j
rs.Fields(j + 1) = oFN
rs.Update
oDoc.Close SaveChanges:úlse
rs.Close
Set rs = Nothing
Set oDoc = Nothing
wApp.Quit
End Function
le second modul :
Public Sub RecupFichier()
Dim oFSO As New FileSystemObject
Dim oFil As File
Dim oFold As Folder
Set oFold = oFSO.GetFolder("serveurrep1Projet1 Janvier 20081
Janvier 2008")
For Each oFil In oFold.Files
If Right(oFil.Name, 4) = "doc" Then
Extract (oFil.Name)
oFil.Move "serveurrep1Projet1 Janvier 20081 Janvier
2008done"
End If
Next oFil
Set oFSO = Nothing
End Sub- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -

sleg

18/09/2008 à 19:54

Bonsoir,

j'ai remplacer le code et la ça bloque sur ma fonction sur ces lignes
"Dim wApp As New Word.Application
Dim oDoc As Word.Document
Dim rs As DAO.Recordset
Dim sql As String
Dim i As Integer, j As Integer"

en revanche cela deplace bien mes fichers de testfiche vers testfiche
done

bonne soirée
"

Public Function Extract(oFN As String)
On Error Resume Next

Dim wApp As New Word.Application
Dim oDoc As Word.Document
Dim rs As DAO.Recordset
Dim sql As String
Dim i As Integer, j As Integer

Set oDoc = wApp.Documents.Open(FileName:="d:testfiche" & oFN)

oDoc.Unprotect

i = oDoc.FormFields.Count
Debug.Print i
Set rs = CurrentDb.OpenRecordset("recup", dbOpenTable)
'édition du jeu d'enregistrement par ajout
rs.AddNew
For j = 1 To i
rs.Fields(j) = oDoc.FormFields(j).Result

Next j
rs.Fields(j + 1) = oFN
rs.Update
oDoc.Close SaveChanges:�lse
rs.Close
Set rs = Nothing
Set oDoc = Nothing
wApp.Quit

End Function

On 18 sep, 17:25, Michel__D
wrote:

Remplace le code de la Sub par celui-ci

Sub RecupFichier()
Dim oFSO As Object
Dim oFil As Object
Dim oFold As Object

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFold = oFSO.GetFolder("d:testfiche")
For Each oFil In oFold.Files
If LCase(Right(oFil.Name, 3)) = "doc" Then
Extract (oFil.Name)
oFil.Move "d:testfichedone" & oFil.Name
End If
Next
Set oFold = Nothing
Set oFil = Nothing
Set oFSO = Nothing
End Sub

sleg a écrit :

> voici le code car impossible de retirer "(" donc voici le code .

> le code :
> Sub RecupFichier()
> Dim oFSO As New FileSystemObject
> Dim oFil As File
> Dim oFold As Folder
> Set oFold = oFSO.GetFolder("d:testfiche")
> For Each oFil In oFold.Files
> If Right(oFil.Name, 4) = "doc" Then
> Extract (oFil.Name)
> oFil.Move "d:testfichedone"
> End If
> Next oFil
> Set oFSO = Nothing

> End Sub

> la fonction :
> Public Function Extract(oFN As String)
> On Error Resume Next
> Dim wApp As New Word.Application
> Dim oDoc As Word.Document
> Dim rs As DAO.Recordset
> Dim sql As String
> Dim i As Integer, j As Integer

> Set oDoc = wApp.Documents.Open(FileName:="d:testfiche" & oFN)

> oDoc.Unprotect

> i = oDoc.FormFields.Count
> Debug.Print i
> Set rs = CurrentDb.OpenRecordset("recup", dbOpenTable)
> 'édition du jeu d'enregistrement par ajout
> rs.AddNew
> For j = 1 To i
> rs.Fields(j) = oDoc.FormFields(j).Result

> Next j
> rs.Fields(j + 1) = oFN
> rs.Update
> oDoc.Close SaveChanges:�lse
> rs.Close
> Set rs = Nothing
> Set oDoc = Nothing
> wApp.Quit

> End Function

> On 18 sep, 16:52, Michel__D
> wrote:
>> Tu n'aurais pas oublier ceci :

>> Dim oFSO As New FileSystemObject
>> Dim oFil As File
>> Dim oFold As Folder

>> Et aussi enlever le "" à la fin de
>> Set oFold = oFSO.GetFolder("d:testfiche")

>> Normalement si les librairies sont activées (références cochée s)
>> cela devrait aller mieux.

>> Et si cela ne va pas donne le code complet utilisé (function et sub) .

>> sleg a écrit :

>>> l'upload de on fichier
>>>http://www.nelty.fr/fichiers/recupzip.zip
>>> lorsque je fais F8 j'ai ces lignes qui apparraissent en jaune.....
>>> *Sub RecupFichier() *
>>> *Set oFold = oFSO.GetFolder("d:testfiche") *
>>> *For Each oFil In oFold.Files*
>>> *If Right(oFil.Name, 4) = "doc" Then*
>>> *End If*
>>> *Next oFil*
>>> merci de ton aide.
>>> On 18 sep, 13:06, Michel__D
>>> wrote:
>>>> sleg a écrit :
>>>>> Non aucun message d'erreur et le pas a pas me donne rien ou je ne s ais
>>>>> pas l'utiliser ...
>>>> Tu place le curseur sur n'importe quelle ligne de la Sub RecupFichie r()
>>>> et tu appuie sur la touche F8 pour l'exécution en pas à pas.
>>>>> voici mon fichier
>>>>>http://www.easy-upload.net/fichier.php?fichier 08918123415
>>>>> merci de votre aide.
>>>>> On 18 sep, 11:40, Michel__D
>>>>> wrote:
>>>>>> Bonjour,
>>>>>> Il n'y a pas de message d'erreur ?
>>>>>> Sinon exécuter en pas en pas.
>>>>>> PS:
>>>>>> La Function Extract(oFN As String) est appelé par la Sub RecupFi chier()
>>>>>> sleg a écrit :
>>>>>>> BOnjour,
>>>>>>> j'ai trouver sur ce site "http://heureuxoli.developpez.com/office /
>>>>>>> sondage/#L4" l'information que je cherchais mais impossible de la ncer
>>>>>>> l'extract.
>>>>>>> une idée ??
>>>>>>> la function :
>>>>>>> Public Function Extract(oFN As String)
>>>>>>> On Error Resume Next
>>>>>>> Dim wApp As New Word.Application
>>>>>>> Dim oDoc As Word.Document
>>>>>>> Dim rs As DAO.Recordset
>>>>>>> Dim sql As String
>>>>>>> Dim i As Integer, j As Integer
>>>>>>> Set oDoc = wApp.Documents.Open(FileName:="serveurrep1Proj et1
>>>>>>> Janvier 2008" & oFN)
>>>>>>> oDoc.Unprotect
>>>>>>> i = oDoc.FormFields.Count
>>>>>>> Debug.Print i
>>>>>>> Set rs = CurrentDb.OpenRecordset("recup", dbOpenTable)
>>>>>>> 'édition du jeu d'enregistrement par ajout
>>>>>>> rs.AddNew
>>>>>>> For j = 1 To i
>>>>>>> rs.Fields(j) = oDoc.FormFields(j).Result
>>>>>>> Next j
>>>>>>> rs.Fields(j + 1) = oFN
>>>>>>> rs.Update
>>>>>>> oDoc.Close SaveChanges:�lse
>>>>>>> rs.Close
>>>>>>> Set rs = Nothing
>>>>>>> Set oDoc = Nothing
>>>>>>> wApp.Quit
>>>>>>> End Function
>>>>>>> le second modul :
>>>>>>> Public Sub RecupFichier()
>>>>>>> Dim oFSO As New FileSystemObject
>>>>>>> Dim oFil As File
>>>>>>> Dim oFold As Folder
>>>>>>> Set oFold = oFSO.GetFolder("serveurrep1Projet1 Janvier 20 081
>>>>>>> Janvier 2008")
>>>>>>> For Each oFil In oFold.Files
>>>>>>> If Right(oFil.Name, 4) = "doc" Then
>>>>>>> Extract (oFil.Name)
>>>>>>> oFil.Move "serveurrep1Projet1 Janvier 2008 01 Janvier
>>>>>>> 2008done"
>>>>>>> End If
>>>>>>> Next oFil
>>>>>>> Set oFSO = Nothing
>>>>>>> End Sub- Masquer le texte des messages précédents -
>>>>>> - Afficher le texte des messages précédents -- Masquer le text e des messages précédents -
>>>> - Afficher le texte des messages précédents -- Masquer le texte des messages précédents -
>> - Afficher le texte des messages précédents -- Masquer le texte de s messages précédents -

- Afficher le texte des messages précédents -

Bonsoir,

j'ai remplacer le code et la ça bloque sur ma fonction sur ces lignes
"Dim wApp As New Word.Application
Dim oDoc As Word.Document
Dim rs As DAO.Recordset
Dim sql As String
Dim i As Integer, j As Integer"

en revanche cela deplace bien mes fichers de testfiche vers testfiche
done

bonne soirée
"

Public Function Extract(oFN As String)
On Error Resume Next

Dim wApp As New Word.Application
Dim oDoc As Word.Document
Dim rs As DAO.Recordset
Dim sql As String
Dim i As Integer, j As Integer

Set oDoc = wApp.Documents.Open(FileName:="d:testfiche" & oFN)

oDoc.Unprotect

i = oDoc.FormFields.Count
Debug.Print i
Set rs = CurrentDb.OpenRecordset("recup", dbOpenTable)
'édition du jeu d'enregistrement par ajout
rs.AddNew
For j = 1 To i
rs.Fields(j) = oDoc.FormFields(j).Result

Next j
rs.Fields(j + 1) = oFN
rs.Update
oDoc.Close SaveChanges:=False
rs.Close
Set rs = Nothing
Set oDoc = Nothing
wApp.Quit

End Function

On 18 sep, 17:25, Michel__D <Michel.NOS...@orange-ft.com.invalid>
wrote:

Remplace le code de la Sub par celui-ci

Sub RecupFichier()
Dim oFSO As Object
Dim oFil As Object
Dim oFold As Object

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFold = oFSO.GetFolder("d:testfiche")
For Each oFil In oFold.Files
If LCase(Right(oFil.Name, 3)) = "doc" Then
Extract (oFil.Name)
oFil.Move "d:testfichedone" & oFil.Name
End If
Next
Set oFold = Nothing
Set oFil = Nothing
Set oFSO = Nothing
End Sub

sleg a écrit :

> voici le code car impossible de retirer "(" donc voici le code .

> le code :
> Sub RecupFichier()
> Dim oFSO As New FileSystemObject
> Dim oFil As File
> Dim oFold As Folder
> Set oFold = oFSO.GetFolder("d:testfiche")
> For Each oFil In oFold.Files
> If Right(oFil.Name, 4) = "doc" Then
> Extract (oFil.Name)
> oFil.Move "d:testfichedone"
> End If
> Next oFil
> Set oFSO = Nothing

> End Sub

> la fonction :
> Public Function Extract(oFN As String)
> On Error Resume Next
> Dim wApp As New Word.Application
> Dim oDoc As Word.Document
> Dim rs As DAO.Recordset
> Dim sql As String
> Dim i As Integer, j As Integer

> Set oDoc = wApp.Documents.Open(FileName:="d:testfiche" & oFN)

> oDoc.Unprotect

> i = oDoc.FormFields.Count
> Debug.Print i
> Set rs = CurrentDb.OpenRecordset("recup", dbOpenTable)
> 'édition du jeu d'enregistrement par ajout
> rs.AddNew
> For j = 1 To i
> rs.Fields(j) = oDoc.FormFields(j).Result

> Next j
> rs.Fields(j + 1) = oFN
> rs.Update
> oDoc.Close SaveChanges:=False
> rs.Close
> Set rs = Nothing
> Set oDoc = Nothing
> wApp.Quit

> End Function

> On 18 sep, 16:52, Michel__D <Michel.NOS...@orange-ft.com.invalid>
> wrote:
>> Tu n'aurais pas oublier ceci :

>> Dim oFSO As New FileSystemObject
>> Dim oFil As File
>> Dim oFold As Folder

>> Et aussi enlever le "" à la fin de
>> Set oFold = oFSO.GetFolder("d:testfiche")

>> Normalement si les librairies sont activées (références cochée s)
>> cela devrait aller mieux.

>> Et si cela ne va pas donne le code complet utilisé (function et sub) .

>> sleg a écrit :

>>> l'upload de on fichier
>>>http://www.nelty.fr/fichiers/recupzip.zip
>>> lorsque je fais F8 j'ai ces lignes qui apparraissent en jaune.....
>>> *Sub RecupFichier() *
>>> *Set oFold = oFSO.GetFolder("d:testfiche") *
>>> *For Each oFil In oFold.Files*
>>> *If Right(oFil.Name, 4) = "doc" Then*
>>> *End If*
>>> *Next oFil*
>>> merci de ton aide.
>>> On 18 sep, 13:06, Michel__D <Michel.NOS...@orange-ft.com.invalid>
>>> wrote:
>>>> sleg a écrit :
>>>>> Non aucun message d'erreur et le pas a pas me donne rien ou je ne s ais
>>>>> pas l'utiliser ...
>>>> Tu place le curseur sur n'importe quelle ligne de la Sub RecupFichie r()
>>>> et tu appuie sur la touche F8 pour l'exécution en pas à pas.
>>>>> voici mon fichier
>>>>>http://www.easy-upload.net/fichier.php?fichier=2008918123415
>>>>> merci de votre aide.
>>>>> On 18 sep, 11:40, Michel__D <Michel.NOS...@orange-ft.com.invalid>
>>>>> wrote:
>>>>>> Bonjour,
>>>>>> Il n'y a pas de message d'erreur ?
>>>>>> Sinon exécuter en pas en pas.
>>>>>> PS:
>>>>>> La Function Extract(oFN As String) est appelé par la Sub RecupFi chier()
>>>>>> sleg a écrit :
>>>>>>> BOnjour,
>>>>>>> j'ai trouver sur ce site "http://heureuxoli.developpez.com/office /
>>>>>>> sondage/#L4" l'information que je cherchais mais impossible de la ncer
>>>>>>> l'extract.
>>>>>>> une idée ??
>>>>>>> la function :
>>>>>>> Public Function Extract(oFN As String)
>>>>>>> On Error Resume Next
>>>>>>> Dim wApp As New Word.Application
>>>>>>> Dim oDoc As Word.Document
>>>>>>> Dim rs As DAO.Recordset
>>>>>>> Dim sql As String
>>>>>>> Dim i As Integer, j As Integer
>>>>>>> Set oDoc = wApp.Documents.Open(FileName:="\serveurrep1Proj et1
>>>>>>> Janvier 2008" & oFN)
>>>>>>> oDoc.Unprotect
>>>>>>> i = oDoc.FormFields.Count
>>>>>>> Debug.Print i
>>>>>>> Set rs = CurrentDb.OpenRecordset("recup", dbOpenTable)
>>>>>>> 'édition du jeu d'enregistrement par ajout
>>>>>>> rs.AddNew
>>>>>>> For j = 1 To i
>>>>>>> rs.Fields(j) = oDoc.FormFields(j).Result
>>>>>>> Next j
>>>>>>> rs.Fields(j + 1) = oFN
>>>>>>> rs.Update
>>>>>>> oDoc.Close SaveChanges:=False
>>>>>>> rs.Close
>>>>>>> Set rs = Nothing
>>>>>>> Set oDoc = Nothing
>>>>>>> wApp.Quit
>>>>>>> End Function
>>>>>>> le second modul :
>>>>>>> Public Sub RecupFichier()
>>>>>>> Dim oFSO As New FileSystemObject
>>>>>>> Dim oFil As File
>>>>>>> Dim oFold As Folder
>>>>>>> Set oFold = oFSO.GetFolder("\serveurrep1Projet1 Janvier 20 081
>>>>>>> Janvier 2008")
>>>>>>> For Each oFil In oFold.Files
>>>>>>> If Right(oFil.Name, 4) = "doc" Then
>>>>>>> Extract (oFil.Name)
>>>>>>> oFil.Move "\serveurrep1Projet1 Janvier 2008 01 Janvier
>>>>>>> 2008done"
>>>>>>> End If
>>>>>>> Next oFil
>>>>>>> Set oFSO = Nothing
>>>>>>> End Sub- Masquer le texte des messages précédents -
>>>>>> - Afficher le texte des messages précédents -- Masquer le text e des messages précédents -
>>>> - Afficher le texte des messages précédents -- Masquer le texte des messages précédents -
>> - Afficher le texte des messages précédents -- Masquer le texte de s messages précédents -

- Afficher le texte des messages précédents -

Vous avez filtré cet utilisateur ! Consultez son message

Bonsoir,

j'ai remplacer le code et la ça bloque sur ma fonction sur ces lignes
"Dim wApp As New Word.Application
Dim oDoc As Word.Document
Dim rs As DAO.Recordset
Dim sql As String
Dim i As Integer, j As Integer"

en revanche cela deplace bien mes fichers de testfiche vers testfiche
done

bonne soirée
"

Public Function Extract(oFN As String)
On Error Resume Next

Dim wApp As New Word.Application
Dim oDoc As Word.Document
Dim rs As DAO.Recordset
Dim sql As String
Dim i As Integer, j As Integer

Set oDoc = wApp.Documents.Open(FileName:="d:testfiche" & oFN)

oDoc.Unprotect

i = oDoc.FormFields.Count
Debug.Print i
Set rs = CurrentDb.OpenRecordset("recup", dbOpenTable)
'édition du jeu d'enregistrement par ajout
rs.AddNew
For j = 1 To i
rs.Fields(j) = oDoc.FormFields(j).Result

Next j
rs.Fields(j + 1) = oFN
rs.Update
oDoc.Close SaveChanges:�lse
rs.Close
Set rs = Nothing
Set oDoc = Nothing
wApp.Quit

End Function

On 18 sep, 17:25, Michel__D
wrote:

Remplace le code de la Sub par celui-ci

Sub RecupFichier()
Dim oFSO As Object
Dim oFil As Object
Dim oFold As Object

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFold = oFSO.GetFolder("d:testfiche")
For Each oFil In oFold.Files
If LCase(Right(oFil.Name, 3)) = "doc" Then
Extract (oFil.Name)
oFil.Move "d:testfichedone" & oFil.Name
End If
Next
Set oFold = Nothing
Set oFil = Nothing
Set oFSO = Nothing
End Sub

sleg a écrit :

> voici le code car impossible de retirer "(" donc voici le code .

> le code :
> Sub RecupFichier()
> Dim oFSO As New FileSystemObject
> Dim oFil As File
> Dim oFold As Folder
> Set oFold = oFSO.GetFolder("d:testfiche")
> For Each oFil In oFold.Files
> If Right(oFil.Name, 4) = "doc" Then
> Extract (oFil.Name)
> oFil.Move "d:testfichedone"
> End If
> Next oFil
> Set oFSO = Nothing

> End Sub

> la fonction :
> Public Function Extract(oFN As String)
> On Error Resume Next
> Dim wApp As New Word.Application
> Dim oDoc As Word.Document
> Dim rs As DAO.Recordset
> Dim sql As String
> Dim i As Integer, j As Integer

> Set oDoc = wApp.Documents.Open(FileName:="d:testfiche" & oFN)

> oDoc.Unprotect

> i = oDoc.FormFields.Count
> Debug.Print i
> Set rs = CurrentDb.OpenRecordset("recup", dbOpenTable)
> 'édition du jeu d'enregistrement par ajout
> rs.AddNew
> For j = 1 To i
> rs.Fields(j) = oDoc.FormFields(j).Result

> Next j
> rs.Fields(j + 1) = oFN
> rs.Update
> oDoc.Close SaveChanges:�lse
> rs.Close
> Set rs = Nothing
> Set oDoc = Nothing
> wApp.Quit

> End Function

> On 18 sep, 16:52, Michel__D
> wrote:
>> Tu n'aurais pas oublier ceci :

>> Dim oFSO As New FileSystemObject
>> Dim oFil As File
>> Dim oFold As Folder

>> Et aussi enlever le "" à la fin de
>> Set oFold = oFSO.GetFolder("d:testfiche")

>> Normalement si les librairies sont activées (références cochée s)
>> cela devrait aller mieux.

>> Et si cela ne va pas donne le code complet utilisé (function et sub) .

>> sleg a écrit :

>>> l'upload de on fichier
>>>http://www.nelty.fr/fichiers/recupzip.zip
>>> lorsque je fais F8 j'ai ces lignes qui apparraissent en jaune.....
>>> *Sub RecupFichier() *
>>> *Set oFold = oFSO.GetFolder("d:testfiche") *
>>> *For Each oFil In oFold.Files*
>>> *If Right(oFil.Name, 4) = "doc" Then*
>>> *End If*
>>> *Next oFil*
>>> merci de ton aide.
>>> On 18 sep, 13:06, Michel__D
>>> wrote:
>>>> sleg a écrit :
>>>>> Non aucun message d'erreur et le pas a pas me donne rien ou je ne s ais
>>>>> pas l'utiliser ...
>>>> Tu place le curseur sur n'importe quelle ligne de la Sub RecupFichie r()
>>>> et tu appuie sur la touche F8 pour l'exécution en pas à pas.
>>>>> voici mon fichier
>>>>>http://www.easy-upload.net/fichier.php?fichier 08918123415
>>>>> merci de votre aide.
>>>>> On 18 sep, 11:40, Michel__D
>>>>> wrote:
>>>>>> Bonjour,
>>>>>> Il n'y a pas de message d'erreur ?
>>>>>> Sinon exécuter en pas en pas.
>>>>>> PS:
>>>>>> La Function Extract(oFN As String) est appelé par la Sub RecupFi chier()
>>>>>> sleg a écrit :
>>>>>>> BOnjour,
>>>>>>> j'ai trouver sur ce site "http://heureuxoli.developpez.com/office /
>>>>>>> sondage/#L4" l'information que je cherchais mais impossible de la ncer
>>>>>>> l'extract.
>>>>>>> une idée ??
>>>>>>> la function :
>>>>>>> Public Function Extract(oFN As String)
>>>>>>> On Error Resume Next
>>>>>>> Dim wApp As New Word.Application
>>>>>>> Dim oDoc As Word.Document
>>>>>>> Dim rs As DAO.Recordset
>>>>>>> Dim sql As String
>>>>>>> Dim i As Integer, j As Integer
>>>>>>> Set oDoc = wApp.Documents.Open(FileName:="serveurrep1Proj et1
>>>>>>> Janvier 2008" & oFN)
>>>>>>> oDoc.Unprotect
>>>>>>> i = oDoc.FormFields.Count
>>>>>>> Debug.Print i
>>>>>>> Set rs = CurrentDb.OpenRecordset("recup", dbOpenTable)
>>>>>>> 'édition du jeu d'enregistrement par ajout
>>>>>>> rs.AddNew
>>>>>>> For j = 1 To i
>>>>>>> rs.Fields(j) = oDoc.FormFields(j).Result
>>>>>>> Next j
>>>>>>> rs.Fields(j + 1) = oFN
>>>>>>> rs.Update
>>>>>>> oDoc.Close SaveChanges:�lse
>>>>>>> rs.Close
>>>>>>> Set rs = Nothing
>>>>>>> Set oDoc = Nothing
>>>>>>> wApp.Quit
>>>>>>> End Function
>>>>>>> le second modul :
>>>>>>> Public Sub RecupFichier()
>>>>>>> Dim oFSO As New FileSystemObject
>>>>>>> Dim oFil As File
>>>>>>> Dim oFold As Folder
>>>>>>> Set oFold = oFSO.GetFolder("serveurrep1Projet1 Janvier 20 081
>>>>>>> Janvier 2008")
>>>>>>> For Each oFil In oFold.Files
>>>>>>> If Right(oFil.Name, 4) = "doc" Then
>>>>>>> Extract (oFil.Name)
>>>>>>> oFil.Move "serveurrep1Projet1 Janvier 2008 01 Janvier
>>>>>>> 2008done"
>>>>>>> End If
>>>>>>> Next oFil
>>>>>>> Set oFSO = Nothing
>>>>>>> End Sub- Masquer le texte des messages précédents -
>>>>>> - Afficher le texte des messages précédents -- Masquer le text e des messages précédents -
>>>> - Afficher le texte des messages précédents -- Masquer le texte des messages précédents -
>> - Afficher le texte des messages précédents -- Masquer le texte de s messages précédents -

- Afficher le texte des messages précédents -

chpa

28/09/2008 à 23:14

Bonsoir,
J'ai bien peur que ton instruction
If Right(oFil.Name, 4) = "doc" Then
ne te renvoie toujours "False"
étant donné que le string "doc" ne fait que 3 caractères.

"sleg" a écrit dans le message de
news:
l'upload de on fichier
http://www.nelty.fr/fichiers/recupzip.zip

lorsque je fais F8 j'ai ces lignes qui apparraissent en jaune.....

*Sub RecupFichier() *
*Set oFold = oFSO.GetFolder("d:testfiche") *
*For Each oFil In oFold.Files*
*If Right(oFil.Name, 4) = "doc" Then*
*End If*
*Next oFil*

merci de ton aide.

On 18 sep, 13:06, Michel__D
wrote:

sleg a écrit :

> Non aucun message d'erreur et le pas a pas me donne rien ou je ne sais
> pas l'utiliser ...

Tu place le curseur sur n'importe quelle ligne de la Sub RecupFichier()
et tu appuie sur la touche F8 pour l'exécution en pas à pas.

> voici mon fichier
>http://www.easy-upload.net/fichier.php?fichier 08918123415

> merci de votre aide.

> On 18 sep, 11:40, Michel__D
> wrote:
>> Bonjour,

>> Il n'y a pas de message d'erreur ?

>> Sinon exécuter en pas en pas.

>> PS:
>> La Function Extract(oFN As String) est appelé par la Sub RecupFichier()

>> sleg a écrit :

>>> BOnjour,
>>> j'ai trouver sur ce site "http://heureuxoli.developpez.com/office/
>>> sondage/#L4" l'information que je cherchais mais impossible de lancer
>>> l'extract.
>>> une idée ??
>>> la function :
>>> Public Function Extract(oFN As String)
>>> On Error Resume Next
>>> Dim wApp As New Word.Application
>>> Dim oDoc As Word.Document
>>> Dim rs As DAO.Recordset
>>> Dim sql As String
>>> Dim i As Integer, j As Integer
>>> Set oDoc = wApp.Documents.Open(FileName:="serveurrep1Projet1
>>> Janvier 2008" & oFN)
>>> oDoc.Unprotect
>>> i = oDoc.FormFields.Count
>>> Debug.Print i
>>> Set rs = CurrentDb.OpenRecordset("recup", dbOpenTable)
>>> 'édition du jeu d'enregistrement par ajout
>>> rs.AddNew
>>> For j = 1 To i
>>> rs.Fields(j) = oDoc.FormFields(j).Result
>>> Next j
>>> rs.Fields(j + 1) = oFN
>>> rs.Update
>>> oDoc.Close SaveChanges:úlse
>>> rs.Close
>>> Set rs = Nothing
>>> Set oDoc = Nothing
>>> wApp.Quit
>>> End Function
>>> le second modul :
>>> Public Sub RecupFichier()
>>> Dim oFSO As New FileSystemObject
>>> Dim oFil As File
>>> Dim oFold As Folder
>>> Set oFold = oFSO.GetFolder("serveurrep1Projet1 Janvier 20081
>>> Janvier 2008")
>>> For Each oFil In oFold.Files
>>> If Right(oFil.Name, 4) = "doc" Then
>>> Extract (oFil.Name)
>>> oFil.Move "serveurrep1Projet1 Janvier 20081 Janvier
>>> 2008done"
>>> End If
>>> Next oFil
>>> Set oFSO = Nothing
>>> End Sub- Masquer le texte des messages précédents -
>> - Afficher le texte des messages précédents -- Masquer le texte des
>> messages précédents -

- Afficher le texte des messages précédents -

Bonsoir,
J'ai bien peur que ton instruction
If Right(oFil.Name, 4) = "doc" Then
ne te renvoie toujours "False"
étant donné que le string "doc" ne fait que 3 caractères.

"sleg" <bastientot@gmail.com> a écrit dans le message de
news:90e38d3f-cc04-4bec-9274-3c9820b0b70a@m44g2000hsc.googlegroups.com...
l'upload de on fichier
http://www.nelty.fr/fichiers/recupzip.zip

lorsque je fais F8 j'ai ces lignes qui apparraissent en jaune.....

*Sub RecupFichier() *
*Set oFold = oFSO.GetFolder("d:testfiche") *
*For Each oFil In oFold.Files*
*If Right(oFil.Name, 4) = "doc" Then*
*End If*
*Next oFil*

merci de ton aide.

On 18 sep, 13:06, Michel__D <Michel.NOS...@orange-ft.com.invalid>
wrote:

sleg a écrit :

> Non aucun message d'erreur et le pas a pas me donne rien ou je ne sais
> pas l'utiliser ...

Tu place le curseur sur n'importe quelle ligne de la Sub RecupFichier()
et tu appuie sur la touche F8 pour l'exécution en pas à pas.

> voici mon fichier
>http://www.easy-upload.net/fichier.php?fichier 08918123415

> merci de votre aide.

> On 18 sep, 11:40, Michel__D <Michel.NOS...@orange-ft.com.invalid>
> wrote:
>> Bonjour,

>> Il n'y a pas de message d'erreur ?

>> Sinon exécuter en pas en pas.

>> PS:
>> La Function Extract(oFN As String) est appelé par la Sub RecupFichier()

>> sleg a écrit :

>>> BOnjour,
>>> j'ai trouver sur ce site "http://heureuxoli.developpez.com/office/
>>> sondage/#L4" l'information que je cherchais mais impossible de lancer
>>> l'extract.
>>> une idée ??
>>> la function :
>>> Public Function Extract(oFN As String)
>>> On Error Resume Next
>>> Dim wApp As New Word.Application
>>> Dim oDoc As Word.Document
>>> Dim rs As DAO.Recordset
>>> Dim sql As String
>>> Dim i As Integer, j As Integer
>>> Set oDoc = wApp.Documents.Open(FileName:="\serveurrep1Projet1
>>> Janvier 2008" & oFN)
>>> oDoc.Unprotect
>>> i = oDoc.FormFields.Count
>>> Debug.Print i
>>> Set rs = CurrentDb.OpenRecordset("recup", dbOpenTable)
>>> 'édition du jeu d'enregistrement par ajout
>>> rs.AddNew
>>> For j = 1 To i
>>> rs.Fields(j) = oDoc.FormFields(j).Result
>>> Next j
>>> rs.Fields(j + 1) = oFN
>>> rs.Update
>>> oDoc.Close SaveChanges:úlse
>>> rs.Close
>>> Set rs = Nothing
>>> Set oDoc = Nothing
>>> wApp.Quit
>>> End Function
>>> le second modul :
>>> Public Sub RecupFichier()
>>> Dim oFSO As New FileSystemObject
>>> Dim oFil As File
>>> Dim oFold As Folder
>>> Set oFold = oFSO.GetFolder("\serveurrep1Projet1 Janvier 20081
>>> Janvier 2008")
>>> For Each oFil In oFold.Files
>>> If Right(oFil.Name, 4) = "doc" Then
>>> Extract (oFil.Name)
>>> oFil.Move "\serveurrep1Projet1 Janvier 20081 Janvier
>>> 2008done"
>>> End If
>>> Next oFil
>>> Set oFSO = Nothing
>>> End Sub- Masquer le texte des messages précédents -
>> - Afficher le texte des messages précédents -- Masquer le texte des
>> messages précédents -

- Afficher le texte des messages précédents -

Vous avez filtré cet utilisateur ! Consultez son message

Bonsoir,
J'ai bien peur que ton instruction
If Right(oFil.Name, 4) = "doc" Then
ne te renvoie toujours "False"
étant donné que le string "doc" ne fait que 3 caractères.

"sleg" a écrit dans le message de
news:
l'upload de on fichier
http://www.nelty.fr/fichiers/recupzip.zip

lorsque je fais F8 j'ai ces lignes qui apparraissent en jaune.....

*Sub RecupFichier() *
*Set oFold = oFSO.GetFolder("d:testfiche") *
*For Each oFil In oFold.Files*
*If Right(oFil.Name, 4) = "doc" Then*
*End If*
*Next oFil*

merci de ton aide.

On 18 sep, 13:06, Michel__D
wrote:

sleg a écrit :

> Non aucun message d'erreur et le pas a pas me donne rien ou je ne sais
> pas l'utiliser ...

Tu place le curseur sur n'importe quelle ligne de la Sub RecupFichier()
et tu appuie sur la touche F8 pour l'exécution en pas à pas.

> voici mon fichier
>http://www.easy-upload.net/fichier.php?fichier 08918123415

> merci de votre aide.

> On 18 sep, 11:40, Michel__D
> wrote:
>> Bonjour,

>> Il n'y a pas de message d'erreur ?

>> Sinon exécuter en pas en pas.

>> PS:
>> La Function Extract(oFN As String) est appelé par la Sub RecupFichier()

>> sleg a écrit :

>>> BOnjour,
>>> j'ai trouver sur ce site "http://heureuxoli.developpez.com/office/
>>> sondage/#L4" l'information que je cherchais mais impossible de lancer
>>> l'extract.
>>> une idée ??
>>> la function :
>>> Public Function Extract(oFN As String)
>>> On Error Resume Next
>>> Dim wApp As New Word.Application
>>> Dim oDoc As Word.Document
>>> Dim rs As DAO.Recordset
>>> Dim sql As String
>>> Dim i As Integer, j As Integer
>>> Set oDoc = wApp.Documents.Open(FileName:="serveurrep1Projet1
>>> Janvier 2008" & oFN)
>>> oDoc.Unprotect
>>> i = oDoc.FormFields.Count
>>> Debug.Print i
>>> Set rs = CurrentDb.OpenRecordset("recup", dbOpenTable)
>>> 'édition du jeu d'enregistrement par ajout
>>> rs.AddNew
>>> For j = 1 To i
>>> rs.Fields(j) = oDoc.FormFields(j).Result
>>> Next j
>>> rs.Fields(j + 1) = oFN
>>> rs.Update
>>> oDoc.Close SaveChanges:úlse
>>> rs.Close
>>> Set rs = Nothing
>>> Set oDoc = Nothing
>>> wApp.Quit
>>> End Function
>>> le second modul :
>>> Public Sub RecupFichier()
>>> Dim oFSO As New FileSystemObject
>>> Dim oFil As File
>>> Dim oFold As Folder
>>> Set oFold = oFSO.GetFolder("serveurrep1Projet1 Janvier 20081
>>> Janvier 2008")
>>> For Each oFil In oFold.Files
>>> If Right(oFil.Name, 4) = "doc" Then
>>> Extract (oFil.Name)
>>> oFil.Move "serveurrep1Projet1 Janvier 20081 Janvier
>>> 2008done"
>>> End If
>>> Next oFil
>>> Set oFSO = Nothing
>>> End Sub- Masquer le texte des messages précédents -
>> - Afficher le texte des messages précédents -- Masquer le texte des
>> messages précédents -

- Afficher le texte des messages précédents -

1 2

import de data d'un formulaire word vers access.

3 réponses

Veuillez sélectionner un problème