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

import de data d'un formulaire word vers access.

13 réponses
Avatar
sleg
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

10 réponses

1 2
Avatar
Philippe
Bonjour

Pourquoi ne pas demander à l'auteur de cet article ?

Philippe

"sleg" a écrit dans le message de
news:
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:="serveurrep1Projet 1
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("serveurrep1Projet 1 Janvier 2008 1
Janvier 2008")
For Each oFil In oFold.Files
If Right(oFil.Name, 4) = "doc" Then
Extract (oFil.Name)
oFil.Move "serveurrep1Projet 1 Janvier 2008 1 Janvier
2008done"
End If
Next oFil
Set oFSO = Nothing

End Sub
Avatar
Michel__D
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:="serveurrep1Projet 1
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("serveurrep1Projet 1 Janvier 2008 1
Janvier 2008")
For Each oFil In oFold.Files
If Right(oFil.Name, 4) = "doc" Then
Extract (oFil.Name)
oFil.Move "serveurrep1Projet 1 Janvier 2008 1 Janvier
2008done"
End If
Next oFil
Set oFSO = Nothing

End Sub


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

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:="serveurrep1Projet 1
> 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("serveurrep1Projet 1 Janvier 2008 1
> Janvier 2008")
> For Each oFil In oFold.Files
>     If Right(oFil.Name, 4) = "doc" Then
>         Extract (oFil.Name)
>         oFil.Move "serveurrep1Projet 1 Janvier 2008 1 Jan vier
> 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 -


Avatar
Michel__D
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:="serveurrep1Projet 1
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("serveurrep1Projet 1 Janvier 2008 1
Janvier 2008")
For Each oFil In oFold.Files
If Right(oFil.Name, 4) = "doc" Then
Extract (oFil.Name)
oFil.Move "serveurrep1Projet 1 Janvier 2008 1 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 -





Avatar
sleg
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 RecupFichie r()

>> 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:="serveurrep1Projet 1
>>> 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("serveurrep1Projet 1 Janvier 2008 1
>>> Janvier 2008")
>>> For Each oFil In oFold.Files
>>>     If Right(oFil.Name, 4) = "doc" Then
>>>         Extract (oFil.Name)
>>>         oFil.Move "serveurrep1Projet 1 Janvier 2008 1 J anvier
>>> 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 de s messages précédents -

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


Avatar
3stone
Salut,

"sleg"
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*
____________


Tu as coché la référence à "Microsoft Scripting Runtime" ?

--
A+
Pierre (3stone) Access MVP
Perso: http://www.3stone.be/
MPFA: http://www.mpfa.info/ (infos générales)
Avatar
sleg
Oui mais pas de changement ??


On 18 sep, 15:39, "3stone" wrote:
Salut,

"sleg"
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*
____________

Tu as coché la référence à "Microsoft Scripting Runtime" ?

--
A+
Pierre (3stone) Access MVP
Perso:http://www.3stone.be/
MPFA:http://www.mpfa.info/ (infos générales)


Avatar
sleg
J'oubliais je suis en access 2000 je sais pas si cela a une
importance.




On 18 sep, 16:06, sleg wrote:
Oui mais pas de changement ??

On 18 sep, 15:39, "3stone" wrote:



> Salut,

> "sleg"
> 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*
> ____________

> Tu as coché la référence à "Microsoft Scripting Runtime" ?

> --
> A+
> Pierre (3stone) Access MVP
> Perso:http://www.3stone.be/
> MPFA:http://www.mpfa.info/ (infos générales)- Masquer le texte de s messages précédents -

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


Avatar
Michel__D
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:="serveurrep1Projet 1
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("serveurrep1Projet 1 Janvier 2008 1
Janvier 2008")
For Each oFil In oFold.Files
If Right(oFil.Name, 4) = "doc" Then
Extract (oFil.Name)
oFil.Move "serveurrep1Projet 1 Janvier 2008 1 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 -





Avatar
sleg
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 sai s
>>> 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 RecupFich ier()
>>>> 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 lanc er
>>>>> 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:="serveurrep1Projet 1
>>>>> 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("serveurrep1Projet 1 Janvier 2008 1
>>>>> Janvier 2008")
>>>>> For Each oFil In oFold.Files
>>>>>     If Right(oFil.Name, 4) = "doc" Then
>>>>>         Extract (oFil.Name)
>>>>>         oFil.Move "serveurrep1Projet 1 Janvier 2008 1 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 de s messages précédents -

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


1 2