import de data d'un formulaire word vers access.

Le
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é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:="\serveurep1Projet1
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("\serveurep1Projet1 Janvier 20081
Janvier 2008")
For Each oFil In oFold.Files
If Right(oFil.Name, 4) = "doc" Then
Extract (oFil.Name)
oFil.Move "\serveurep1Projet1 Janvier 20081 Janvier
2008done"
End If
Next oFil
Set oFSO = Nothing

End Sub
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses Page 1 / 2
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Philippe
Le #17259401
Bonjour

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

Philippe

"sleg" 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:="\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
Michel__D
Le #17261621
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


sleg
Le #17262131
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:="\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 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 -


Michel__D
Le #17262541
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 -





sleg
Le #17263571
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("\serveurrep1Projet1 Janvier 2008 1
>>> Janvier 2008")
>>> For Each oFil In oFold.Files
>>>     If Right(oFil.Name, 4) = "doc" Then
>>>         Extract (oFil.Name)
>>>         oFil.Move "\serveurrep1Projet1 Janvier 20081 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 -


3stone
Le #17264111
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)
sleg
Le #17264471
Oui mais pas de changement ??


On 18 sep, 15:39, "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)


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




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

On 18 sep, 15:39, "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)- Masquer le texte de s messages précédents -

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


Michel__D
Le #17264781
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 -





sleg
Le #17264821
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("\serveurrep1Projet1 Janvier 2008 1
>>>>> 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 de s messages précédents -

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


Publicité
Poster une réponse
Anonyme