Macro Ecrire Dossier et sous dossiers - VB/VBA/VBS - Programmation
MarshPosté le 09-02-2012 à 13:03:31
Bonjour tout le monde, j'arrive toujours pas à atteindre mon objectif qui est celui d'écrire avec une macro sur plusieurs fichiers excel stocké dans différents dossiers mais ayant un seul dossier parent.
j'arrive pas à faire à établir la connexion.
Option Explicit Sub PRINTER() Dim Cn As ADODB.Connection Dim Fso As Object, MonRepertoire As String Dim f1 As Object, f2 As Object, wb As Workbook
MonRepertoire = "C:\..\.."
Set Cn = New ADODB.Connection Set Fso = CreateObject("Scripting.FileSystemObject" ) Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" & MonRepertoire & ";" & _ "Extended Properties=""Excel 8.0;HDR=No;"";"
For Each f1 In Fso.GetFolder(MonRepertoire).SubFolders For Each f2 In f1.Files Set wb = Workbooks.Open(f2) ActiveSheet.Cells(11, 44).Value = "xxxxxxxxxxx" ActiveSheet.Cells(25, 39).Value = "xxxxxxxxxxx" wb.Close Next f2 Next f1 End Sub
Marsh Posté le 09-02-2012 à 13:03:31
Bonjour tout le monde, j'arrive toujours pas à atteindre mon objectif qui est celui d'écrire avec une macro sur plusieurs fichiers excel stocké dans différents dossiers mais ayant un seul dossier parent.
j'arrive pas à faire à établir la connexion.
Option Explicit
Sub PRINTER()
Dim Cn As ADODB.Connection
Dim Fso As Object, MonRepertoire As String
Dim f1 As Object, f2 As Object, wb As Workbook
MonRepertoire = "C:\..\.."
Set Cn = New ADODB.Connection
Set Fso = CreateObject("Scripting.FileSystemObject" )
Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & MonRepertoire & ";" & _
"Extended Properties=""Excel 8.0;HDR=No;"";"
For Each f1 In Fso.GetFolder(MonRepertoire).SubFolders
For Each f2 In f1.Files
Set wb = Workbooks.Open(f2)
ActiveSheet.Cells(11, 44).Value = "xxxxxxxxxxx"
ActiveSheet.Cells(25, 39).Value = "xxxxxxxxxxx"
wb.Close
Next f2
Next f1
End Sub
merci à celui qui pourra me renseigner
Message édité par varik le 09-02-2012 à 13:04:26