Question

如何用VBA打开固定文件下所有WORD文件，自动运行宏后打印。

我每天都要从别的软件导出N个*.DOC文件，放进地址为文件夹：“C:\Documents and Settings\BATIC02.BANDO-0616CC6F0\桌面\yu\*.*",然后手动打开每个文件，做了个工具件点后逐个执行如下代码：
Sub 研削()
'
' 研削 Macro
' 宏在 2009/04/15 由 BATIC02 录制

ActiveDocument.Sections(1).Range.Select
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.HeaderFooter.Shapes.AddPicture(FileName:="D:\2010年\研1.bmp", _
LinkToFile:=False, SaveWithDocument:=True).Select
Selection.ShapeRange.Name = "WordPictureWatermark1"
Selection.ShapeRange.PictureFormat.Brightness = 0.5
Selection.ShapeRange.PictureFormat.Contrast = 0.5
Selection.ShapeRange.LockAspectRatio = True
Selection.ShapeRange.Height = CentimetersToPoints(28.82)
Selection.ShapeRange.Width = CentimetersToPoints(16.91)
Selection.ShapeRange.WrapFormat.AllowOverlap = True
Selection.ShapeRange.WrapFormat.Side = wdWrapNone
Selection.ShapeRange.WrapFormat.Type = 3
Selection.ShapeRange.RelativeHorizontalPosition = _
wdRelativeVerticalPositionMargin
Selection.ShapeRange.RelativeVerticalPosition = _
wdRelativeVerticalPositionMargin
Selection.ShapeRange.Left = wdShapeCenter
Selection.ShapeRange.Top = wdShapeCenter
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.ClearFormatting
Selection.ClearFormatting
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
Application.PrintOut FileName:="", Range:=wdPrintAllDocument, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:="", PageType:=wdPrintAllPages, _
ManualDuplexPrint:=False, Collate:=True, Background:=True, PrintToFile:= _
False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=11907, _
PrintZoomPaperHeight:=16839
ActiveDocument.Save
ActiveWindow.Close
Application.Quit
End Sub
*结束，保存WORD后打印输入。

执行完后，再手动打开下一个文件，再执行上面代码。

求教：能否把这个循环过程简化一下，让它自动逐次打开这个文件夹下所有.DOC，然后自动执行输出。把这个文件夹下所有.DOC文件批量完成？

Answer 1

处理思路为：制作一个Doc文档，里边包含处理过程的代码。需要使用时，将这个doc文档置于需要处理文档所在文件夹中，执行代码即可自动完成。如此即可达到一劳永逸的效果。

为便于使用，建议此doc文档中放置一个命令按钮（CommandButton，可标记为“开始执行”），一个可供显示处理过的文档名称的列表框（ListBox），单击命令按钮执行需要的处理过程，列表显示文档名，过程结束进行相应的提示。

假设您已经置入了CommandButton和ListBox，请双击CommandButton进入代码编辑窗口，将以下代码复制进去，补充完整您需要的一些操作代码即告完成。

'下面是需要复制的代码：

On Error GoTo handerr:
'请先单击代码编辑窗口的菜单“工具/引用”勾选“Microsoft Scripting Runtime”
'否则将无法使用本代码块，放弃使用 Dir 函数是为了不受版本影响

Dim Str1 As String
Dim Fso As New FileSystemObject
Dim Fl As File
Dim Fd As Folder
Dim odoc As Word.Document

If MsgBox("您确实需要开始执行此过程吗？", vbQuestion + vbYesNo, "提示") = vbNo Then
Exit Sub
End If

'清除显示已经处理的文档名列表，如果不需要，把下面一句删除
ListBox1.Clear

Set Fd = Fso.GetFolder(ThisDocument.Path)

'处理每一个文档
For Each Fl In Fd.Files
Str1 = LCase(Fl.Name)

If InStr(1, Str1, ".doc") > 0 And InStr(1, Str1, "~") = 0 And Str1 <> ThisDocument.Name Then
'如果不需要显示处理的文档名列表，请删除下面一句
ListBox1.AddItem Fl.Name

Set odoc = Documents.Open(CStr(Fl))
odoc.Activate

'下面填写您需要在打开文档后的一些处理动作，如设置页眉，插入图片等

'上面填写您需要处理的一些动作
odoc.Save '保存此文档
odoc.PrintOut '打印此文档
odoc.Close '关闭此文档
End If
Next Fl

'如果上面删除了列表显示语句，请把下面4行删除，再用最后一行进行操作结束
If ListBox1.ListCount > 0 Then
MsgBox "过程执行完毕！" & vbCrLf & "列表中的" & ListBox1.ListCount & "个文档等待打印机打印。", vbInformation, "提示"
Else
MsgBox "过程结束，没有任何文档可操作！", vbInformation, "提示"
End If

'msgbox "过程结束！",vbInformation,"提示"

Exit Sub

handerr:
MsgBox Err.Description, vbInformation, "错误提示"

追问

您好，谢谢您热心的回答，您再帮我看看行么？

做完COMMANDBUTTON1T和LISTBOX1，再双击COMMANDBUTTON1后，所作步骤如下：

我把我的代码从以前的： ActiveDocument.Sections(1).Range.Select
……………………
到: False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=11907, _
PrintZoomPaperHeight:=16839

追答

您把这一行（odoc.PrintOut '打印此文档）删除掉吧，这一句是默认打印的意思，你复制进去的最后一句就是自定义打印。

您用一个文件夹少放两个文件试验一下行不行，如果不行，可传一份需要处理的文档（可能透露机密的文字自己用其它无所谓的文字替换掉，能够表示格式就行）给我506991374@qq.com帮你处理一下，邮件中说明您要做的详细动作。

Answer 2

Sub printwords()
Dim filedir As String
Dim FileName As String
filedir = "C:\Documents and Settings\BATIC02.BANDO-0616CC6F0\桌面\yu\"
FileName = Dir(filedir & "*.doc")
Do While FileName <> ""
Documents.Open (FileName)
ActiveDocument.PrintOut
ActiveDocument.Close False
FileName = Dir
Loop
End Sub
试试这个代码？