[déplacé VB6 - VBA] Impression par rapport à la date de création

Question

Bonjour à tous,

Je suis nouveau sur le forum et j'aimerai un ptit coup de main sur un souci excel en vba.

L'énoncé de mon problème :

Pour faire simple j'ai plusieurs colis qui reviennent de chez mes clients avec un rapport que je scanne et place dans un même dossier en changeant le nom ex : colis1_08-09-09.pdf colis2_08-09-09.pdf colis3_08-09-09 (les anciens rapports sont presents) colis1_01-09-09.pdf colis1_04-09-09.pdf

Ma base de fichiers s'agrandit donc au fil de réception des colis. Lorque j'envoie un colis chez un client je dois imprimer les 3 derniers rapports :

Par exemple si j'envoie le colis 1, je dois imprimer colis1_01-09-09.pdf + colis1_04-09-09 + colis1_09-09-09.

J'aimerais passer par un userform qui recherche ces 3 fichiers mais je ne sais pas si cela est réalisable, je pense que oui mais avec un coup de main sinon ca va être chaud.

Voili voilou

karltheodor · Answer

Tu veux:
1. trouver,
2. ouvrir, et
3. imprimer
les 3 derniers fichiers, c'est ca?

Je n'ai pas la reponse, mais quelques pistes.

1. Trouver

[*] Si tu as Excel <2007, tu peux utiliser Application.FileSearch pour lister tous tes fichiers. C'est facile, mais je ne peux plus l'utiliser.

[*] Si tu as Excel 2007, il faut utiliser ce desagreable Scripting.FileSystemObject il me semble.

Le script ci-dessous liste tous les objets du folder MyApps\delme\ (ne pas executer sur C:\, ca cherche dans les sous repertoire)

[i]Set myFileSystem =  CreateObject("Scripting.FileSystemObject")
  
  For Each iFile In myFileSystem.GetFolder("C:\MyApps\delme").Files
    MsgBox (iFile.Name)
  Next iFile/i

Avec ta convention de nom, ca ne doit pas etre bien difficile de trouver les trois bons noms de fichier

2. Ouvrir
Le plus simple, c'est encore de suivre un hyperlink:

 ActiveWorkbook.FollowHyperlink Address:="C:\Users\Francis Chapuis\Documents\Comment gagner de l'argent en surfant sur Internet.pdf" 

Mais je ne suis pas sur que tu puisse gerer l'impression ensuite. Sinon, avec une reference a la librairie d'Adobe Acrobat, un shell:

a  = Shell("C:\Program Files (x86)\Adobe\Reader 8.0\Reader\AcroRd32.exe C:\MyApps\delme\bla.pdf", 1)

Je n'arrive pour l'instant pas a ouvrir correctement le pdf s'il y a un espace dans le nom / chemin

3. Imprimer
La je ne peux pas trop chercher n'ayant pas d'imprimante (ca demotive). Et le reader d'acrobat ne supporte pas l'automation OLE (il faut la version complete).

Je seche completement. Bon courage (et fait nous partager tes trouvailles)

karltheodor · Answer

Et puis j'ai fait plein de fautes d'orthographe, de grammaire et tout ca. Desolant (d'autant que je remets ca)

Mais une idee m'a traverse l'esprit: Tu veux peut etre utiliser FileDateTime? Voici un apparcu de ce que ca retourne:

Dim myFileSystem As Object
  Set myFileSystem = CreateObject("Scripting.FileSystemObject")
  
  For Each iFile In myFileSystem.GetFolder("C:\MyApps\delme").Files
    MsgBox (iFile.Name & " " & FileDateTime(iFile))
  Next iFile

En fait je n'ai pas bien compris la question, mais ca te permettra d'identifier les derniers fichiers modifies.

waikiki42 · Answer

Bonjour, merci de répondre si vite.

En fait ce que je veux c'est part l'intermédiaire d'un userform tapez le nom (le début du nom recherché) et lorsque je clique sur le bouton valider que ça m'imprime les 3 derniers rapports concernant le nom

ex :

 dans mon dossier, j'ai les fichiers colis1_01-09-09.pdf colis1_03-09-09.pdf colis1_05-09-09.pdf et colis1_09-09-09.pdf.
Lorque je lance mon fichiers excel avec mon userform dans une textbox je voudrai taper colis1 et lorque je clique sur valider qu'il m imprime les 3 derniers rapports donc les derniers fichiers crées colis1_03-09-09.pdf colis1_05-09-09.pdf et colis1_09-09-09.pdf

J'espère que cela aura pu clarifier mes explications

Amicalement

waikiki42 · Answer

Re, bon j'ai avancé un peu voila mon code

Private Sub CommandButton4_Click()
    Dim i As Integer
    Dim strFind As String, strDate As String, z As String
                    Dim blah As FileSearch
                                        Dim MyBk As Workbook, MySht As Worksheet
                                        Dim MyBox As Integer
    strFind = InputBox("Enter part of filename", "Filename")
                    Set blah = Application.FileSearch
    With Application.FileSearch
        .NewSearch
        .LookIn = "C:\Documents and Settings\mplay\Bureau\Nouveau dossier"
        .SearchSubFolders = True
        .Filename = "*" & strFind & "*" & strDate & ".pdf"
        .MatchTextExactly = False
        .LastModified = msoLastModifiedAnyTime
                    .Execute msoSortByLastModified, msoSortOrderDescending
    End With
                    If blah.FoundFiles.Count > 0 Then MsgBox blah.FoundFiles(1)
    z = blah.FoundFiles(1)
                                        Dim Urlto As String
                                        Urlto = z
                                        ShellEx (Urlto)
ShellExecute 0&, "Print", z, "", "", 0&
    With Application.FileSearch
        If .Execute() > 0 Then
        Else
            MsgBox "La référence désignée ne possède pas de rapports"
        End If
    End With
End Sub

Du coup, grace a ça, ça me demande une partie du nom de mon produit et ensuite ça cherche le dernier modifié (c'est une base PDF donc en théorie ça devrait être le dernier crée). Ensuite ça m'ouvre mon PDF, me l imprime.

Il faut juste que je referme Adobe après.

Par contre est-il possible de refaire une recherche à la suite en ne tenant pas compte du premier fichier précédemment trouvé ? Pour trouver mes 2 autres fichiers (avant dernier et antépénultieme )

Merci

karltheodor · Answer

Bonjour,

J'ai ressorti mon vieux portable avec Excel 2003 pour pouvoir jouer avec FileSearch.

Notes:
1.  J'ai cree un UserForm decrit en commentaire ci-dessous et, si je n'ai pu tester entierement l'impression (autre que avec pdf writer) ca a l'air de fonctionner a merveille.

2. Le programme fonctionne ainsi:
a) Tu saisis une partie du nom du fichier dans l'EditBox,
b) tu cliques sur Recherche qui affiche dans le ListBox tous les fichiers correspondants et selectionne par defaut les 3 plus recents
c) tu cliques sur Imprimer pour ouvrir tous les fichiers selectionnes dans Acrobat, les imprimer (j'ai copie ton ShellEx qui est une excellent idee) et, apres une attente (a parametrer) fermer Acrobat

3.  Je ferme Acrobat d'une facon tres bourrine et, plutot que d'adapter le temps de la fonction Wait, tu peux creer un bouton sur la Form pour lancer cette partie du code manuellement apres que l'impression soit terminee. Ca evitera de fermer Acrobat trop vite, et d'avoir des impressions qui echouent si tes fichiers sont long a charger.
Idealement, il faudrait pouvoir recuperer une info du genre "Acrobat a fini" et faire une boucle jusqu'a ce que ce soit le cas.

Le code:
Option Explicit

'Form1: a user form
'ButtonSearch: a button to launch the search
'ButtonExit: a button to exit Form1
'ButtonPrin: a button to print the selected file
'TextBox1: A textbox to enter a part of the files' name
'ListBox1: A list box with MultiSelect enabled (dans les proprietes)

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
 (ByVal hWnd As Long, ByVal lpOperation As String, _
 ByVal lpFile As String, ByVal lpParameters As String, _
 ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Declare Function ShellExecuteForExplore Lib "shell32.dll" Alias "ShellExecuteA" _
 (ByVal hWnd As Long, ByVal lpOperation As String, _
 ByVal lpFile As String, lpParameters As Any, _
 lpDirectory As Any, ByVal nShowCmd As Long) As Long


Const myPath = "C:\Test Folder" 'Repertoire de reference _
                                  declare comme une constance pour l'instant

Private Sub ButtonExit_Click()
'Lance par ButtonExit: Ferme Form1
  Form1.Hide
  Unload Form1
End Sub

Private Sub ButtonPrint_Click()
  
  Dim i As Integer
  Dim oProc
  Dim sQuery
  Dim svc
  
  'Exit si rien n'est selectionne
  If ListBox1.ListCount = 0 Then
    MsgBox ("Rien a imprimer")
    Exit Sub
  End If
  
  'Gestion des fichiers selectionnes
  For i = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(i) Then
      'Impression
      ShellExecute 0&, "Print", myPath & ListBox1.List(i), "", "", 0&
      DoEvents
      'Attend environ 10 secondes pour fermer Acrobat
      'A adapter pour laisser le temps a l'impression
      Application.Wait Now() + 0.0001
      'Fermeture comme un gros bourin
      Set svc = GetObject("winmgmts:root\cimv2")
      sQuery = "select * from win32_process where name='" & "Acrobat.exe" & "'"
      For Each oProc In svc.execquery(sQuery)
        oProc.Terminate
      Next
    Set svc = Nothing

    End If
  Next i
End Sub

Private Sub ButtonSearch_Click()
'Lance par ButtonSearch: List les fichiers
  
  Dim mySearch As FileSearch
  Dim iFile
  Dim i As Integer
  
  'Search for all the files that match the criteria
  Set mySearch = Application.FileSearch
  mySearch.LookIn = myPath
  mySearch.SearchSubFolders = True
  mySearch.Filename = TextBox1.Value & "*.pdf"
  mySearch.Execute msoSortByLastModified, msoSortOrderDescending
  
  'Ajout a la ListBox des fichiers trouves
  'Tu peux t'amuser a ajouter une colonne avec la date
  ListBox1.Clear
  i = 0
  For Each iFile In mySearch.foundFiles
    ListBox1.AddItem (Mid(iFile, Len(myPath) + 1, 99))
    If i < 3 Then ListBox1.Selected(i) = True
    i = i + 1
  Next iFile
  
End Sub

karltheodor · Answer

C'est atroce ce code non formate. J'aurais du utiliser les bannieres.

Si ca ne fonctionne pas, change

  Application.Wait Now() + 0.0001

en

Application.Wait Now() + 0.0005

Ou un truc du genre.

waikiki42 · Answer

Salut et merci à toi pour ce code.

Je rencontre un petit souci par contre, lorsque je tape ma référence dans ma textbox et que je clique sur recherche, il trouve bien les fichiers, mais lorsque je clique sur imprimer,il y en a seulement 1 qui s'imprime et apparemment ce n'est pas le dernier crée.

Merci

karltheodor · Answer

Je suggere d'executer en pas a pas pour voir ce qui ne va pas. Ca fonctionne chez moi aussi je n'ai aucune idee de ce qui t'arrive

waikiki42 · Answer

Re,

J'ai exécuté en pas à pas et j'ai apparemment trouve ce qu'il se passe!

Après avoir cliqué sur le bouton "recherche", mes fichiers sont bien classés par ordre de création mais il n'y a que le troisième qui est sélectionné.

En mode Pas à pas, lorsque le premier fichier est trouvé, il est sélectionné.
Lorsque le deuxième apparait le premier se desélectionne et on sélectionne seulement le 2 eme.
Pareil pour le troisième qui lui reste sélectionné, malgré les autres fichiers trouvés.

En espérant avoir été clair dans mes explications

waikiki42 · Answer

Re, après vérification l'erreur se trouve ici

For Each iFile In mySearch.FoundFiles
ListBox1.AddItem (Mid(iFile, Len(myPath) + 1, 99))

If i < 3 Then ListBox1.Selected(i) = True

i = i + 1
Next iFile

en effet chaque fois qu'on franchi cette ligne cela selectionne la ligne qui appparait mais ne garde pas en mémoire la précédente

karltheodor · Answer

OK. Le ListBox doit avoir la propriete MultiSelect. Il suffit de changer ca et ca devrait fonctionner.

See ya

waikiki42 · Answer

Voici le code qui semble fonctionné 

Private Sub ButtonSearch_Click()
'Lance par ButtonSearch: List les fichiers

Dim mySearch As FileSearch
Dim iFile
Dim i As Integer
Dim svc
Dim oProc
Dim sQuery

'Search for all the files that match the criteria
Set mySearch = Application.FileSearch
mySearch.LookIn = myPath
mySearch.SearchSubFolders = True
mySearch.Filename = TextBox1.Value & "*.pdf"
mySearch.Execute msoSortByLastModified, msoSortOrderDescending

'Ajout a la ListBox des fichiers trouves
'Tu peux t'amuser a ajouter une colonne avec la date
ListBox1.Clear
i = 0
For Each iFile In mySearch.FoundFiles
ListBox1.AddItem (Mid(iFile, Len(myPath) + 1, 99))
If i < 3 Then ListBox1.Selected(i) = True
If i >= 3 Then GoTo a
ShellExecute 0&, "Print", myPath & ListBox1.List(i), "", "", 0&
DoEvents
'Attend environ 10 secondes pour fermer Acrobat
'A adapter pour laisser le temps a l'impression
Application.Wait Now() + 0.0001
'Fermeture comme un gros bourin
Set svc = GetObject("winmgmts:root\cimv2")
sQuery = "select * from win32_process where name='" & "Acrobat.exe" & "'"
For Each oProc In svc.execquery(sQuery)
oProc.Terminate
Next
Set svc = Nothing

i = i + 1
a:
Next iFile

End Sub

Par contre, je voudrai supprimé les autres rapports (donc les 4eme 5eme ....), quelle est la commande à utiliser ?

Kill ??

Merci

waikiki42 · Answer

Merci à tous pour votre aide, mon code fonctionne maintenant, il est peut être pas très très bien écrit mais bon ca marche!

si ça interresse quelqu'un

Option Explicit

'Form1: a user form
'ButtonSearch: a button to launch the search
'ButtonExit: a button to exit Form1
'ButtonPrin: a button to print the selected file
'TextBox1: A textbox to enter a part of the files' name
'ListBox1: A list box with MultiSelect enabled (dans les proprietes)

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hWnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Declare Function ShellExecuteForExplore Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hWnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, lpParameters As Any, _
lpDirectory As Any, ByVal nShowCmd As Long) As Long


Const myPath = "C:\Documents and Settings\mplay\Bureau\Nouveau dossier" 'Repertoire de reference _
declare comme une constance pour l'instant

Private Sub ButtonExit_Click()
'Lance par ButtonExit: Ferme Form1
Form1.Hide
Unload Form1
End Sub
Private Sub UserForm_Initialize()
ListBox1.Visible = False
End Sub


Private Sub ButtonSearch_Click()
'Lance par ButtonSearch: List les fichiers

Dim mySearch As FileSearch
Dim iFile
Dim i, j, k As Integer
Dim svc
Dim oProc
Dim sQuery

If TextBox1.Value = "" Then MsgBox "La référence spécifiée n'existe pas"
If TextBox1.Value = "" Then GoTo z

'Search for all the files that match the criteria
Set mySearch = Application.FileSearch
mySearch.LookIn = myPath
mySearch.SearchSubFolders = True
mySearch.Filename = TextBox1.Value & "*.pdf"
mySearch.Execute msoSortByLastModified, msoSortOrderDescending



'Ajout a la ListBox des fichiers trouves
'Tu peux t'amuser a ajouter une colonne avec la date
ListBox1.Clear
i = 0
j = 2
k = 1
For Each iFile In mySearch.FoundFiles
ListBox1.AddItem (Mid(iFile, Len(myPath) + 1, 99))
If i < 3 Then ListBox1.Selected(i) = True
If i >= 3 Then GoTo a
ShellExecute 0&, "Print", myPath & ListBox1.List(i), "", "", 0&
DoEvents
'Attend environ 10 secondes pour fermer Acrobat
'A adapter pour laisser le temps a l'impression
Application.Wait Now() + 0.0001
'Fermeture comme un gros bourin

i = i + 1

GoTo b

a:
ListBox1.Selected(i) = True
Kill (myPath & ListBox1.List(i))
i = i - k
ListBox1.Selected(i) = True
i = i + j

j = j + 1
k = k + 1
b:
Next iFile

Set svc = GetObject("winmgmts:root\cimv2")
sQuery = "select * from win32_process where name='" & "Acrobat.exe" & "'"
For Each oProc In svc.execquery(sQuery)
oProc.Terminate
Next
Set svc = Nothing

z:
End Sub

[déplacé VB6 -> VBA] Impression par rapport à la date de création

13 réponses

Votre réponse

Discussions similaires