Printing documents and moving to another folder

R

red6000

Hi, I have a folder with 2 subfolders:

a) J:\Central Printing\Docs to be printed
b) J:\Central Printing\Docs sent to be printed

What I would like to do is have a vba macro in word that does the following:

1. Prints the 5 oldest docs in folder a (if possible based on last modified
time)
2. Then move these documents from folder a into folder b

Is this possible, I'm sure it is, but not really sure where to start

Thanks.
 
R

red6000

Okay, I've managed to get the code to work, but it prints in alphabetical
order when I'd love it to print in either oldest date modified or oldest
date created order.

my code so far is:

Sub PrintAndMove()

Dim count As Integer
Dim file As String
count = 0

While count < 5
ChangeFileOpenDirectory _
"J:\Central Printing\To be printed\"
file = Dir("*.doc")
On Error GoTo STOPMACROPRINT
Documents.Open FileName:=file
ActiveDocument.PrintOut Background:=False, Copies:=1
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
OldFilePath = "J:\Central Printing\To be printed\" & file
NewFilePath = "J:\Central Printing\Printed\" & file
Name OldFilePath As NewFilePath
file = Dir()
count = count + 1
Wend

STOPMACROPRINT:

MsgBox (count & " documents have been sent to print and moved to the
'printed' folder")
Dim count2 As Integer
count2 = 0
file = Dir("J:\Central Printing\To be printed\*.doc")
While file <> ""
count2 = count2 + 1
file = Dir()
Wend
MsgBox (count2 & " documents are still to be sent for printing")

End Sub
 
H

Helmut Weber

Hi,

have a look at this one.

create a new blank document beforehand,
and see, whether you get a list of docs in a folder
sorted by last saved date.

It's just for fun,
with lots of ways of improvements left, IMHO.

Have some fun.


Sub Macro2()
Dim l As Long ' a counter for number of files found
Dim x As Long ' a counter for a loop
Dim s As String ' the doc's short name
Dim p As String ' path
Dim n() As String ' array of names
p = "c:\test\"
s = Dir(p & "*.doc", vbNormal)
If s = "" Then Exit Sub
l = 0
While s <> ""
l = l + 1
s = Dir
Wend
' l = number of files found
ReDim n(1 To l)
s = Dir(p & "*.doc", vbNormal)
' put filedatetime in front of the file's fullname
s = FileDateTime(p & s) & s
n(1) = s
For x = 2 To l
s = Dir()
s = FileDateTime(p & s) & s
n(x) = s
Next
WordBasic.sortarray n
' sort them
For x = 1 To l
' 19 characters for filedatetime
Selection.TypeText p & Right(n(x), Len(n(x)) - 19) & vbCrLf
Next

End Sub


--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top